-
Notifications
You must be signed in to change notification settings - Fork 0
/
passive_tracers.F90
1751 lines (1376 loc) · 63.7 KB
/
passive_tracers.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
module passive_tracers
!BOP
! !MODULE: passive_tracers
! !DESCRIPTION:
! This module provides support for passive tracers.
! The base model calls subroutines in this module which then call
! subroutines in individual passive tracer modules.
! !REVISION HISTORY:
! SVN:$Id: passive_tracers.F90 89825 2018-08-30 16:20:47Z [email protected] $
! !USES:
use POP_KindsMod
use POP_ErrorMod
use POP_IOUnitsMod
use kinds_mod, only: r8, int_kind, log_kind, char_len
use blocks, only: block, nx_block, ny_block
use domain_size, only: max_blocks_clinic, km, nt
use domain, only: nblocks_clinic
use communicate, only: my_task, master_task
use broadcast, only: broadcast_scalar
use prognostic, only: TRACER, PSURF, tracer_d, oldtime, curtime, newtime
use forcing_shf, only: SHF_QSW_RAW, SHF_QSW
use forcing_fields, only : lhas_vflux, lhas_riv_flux
use mcog, only: FRACR_BIN, QSW_RAW_BIN, QSW_BIN
use io_types, only: stdout, nml_in, nml_filename, io_field_desc, &
datafile
use exit_mod, only: sigAbort, exit_pop
use timers, only: timer_start, timer_stop
use tavg, only: define_tavg_field, tavg_method_qflux, &
accumulate_tavg_field, accumulate_tavg_now
use constants, only: c0, c1, p5, delim_fmt, char_blank, &
grav, salt_to_ppt, ocn_ref_salinity, ppt_to_salt, sea_ice_salinity
use time_management, only: mix_pass, c2dtt
use grid, only: partial_bottom_cells, DZT, KMT, dz, zw, &
sfc_layer_type, sfc_layer_varthick
use registry, only: register_string, registry_match
use io_tools, only: document
use passive_tracer_tools, only: set_tracer_indices
use ecosys_driver, only: &
ecosys_tracer_cnt, &
ecosys_driver_init, &
ecosys_driver_set_sflux_forcing, &
ecosys_driver_set_sflux, &
ecosys_driver_post_set_sflux, &
ecosys_driver_tavg_forcing, &
ecosys_driver_set_interior_forcing,&
ecosys_driver_set_interior, &
ecosys_driver_set_global_scalars, &
ecosys_driver_comp_global_averages,&
ecosys_driver_write_restart, &
ecosys_driver_tracer_ref_val, &
ecosys_driver_unpack_source_sink_terms
use cfc_mod, only: &
cfc_tracer_cnt, &
cfc_init, &
cfc_set_sflux, &
cfc_tavg_forcing
use sf6_mod, only: &
sf6_tracer_cnt, &
sf6_init, &
sf6_set_sflux, &
sf6_tavg_forcing
use iage_mod, only: &
iage_tracer_cnt, &
iage_init, &
iage_set_interior, &
iage_reset
use bipit_mod, only: &
bipit_tracer_cnt, &
bipit_init, &
bipit_set_interior, &
bipit_reset
use abio_dic_dic14_mod, only: &
abio_dic_dic14_tracer_cnt, &
abio_dic_dic14_init, &
abio_dic_dic14_tracer_ref_val, &
abio_dic_dic14_set_sflux, &
abio_dic_dic14_tavg_forcing, &
abio_dic_dic14_set_interior, &
abio_dic_dic14_write_restart
use IRF_mod, only: IRF_tracer_cnt
use IRF_mod, only: IRF_init
use IRF_mod, only: IRF_reset
implicit none
private
save
! !PUBLIC MEMBER FUNCTIONS:
public :: &
init_passive_tracers, &
set_interior_passive_tracers, &
set_interior_passive_tracers_3D, &
set_sflux_passive_tracers, &
reset_passive_tracers, &
write_restart_passive_tracers, &
tavg_passive_tracers, &
passive_tracers_tavg_sflux, &
passive_tracers_tavg_fvice, &
passive_tracers_timer_print_all, &
passive_tracers_send_time, &
tracer_ref_val, &
tadvect_ctype_passive_tracers, &
ecosys_on
!EOP
!BOC
!-----------------------------------------------------------------------
! tavg ids for automatically generated tavg passive-tracer fields
!-----------------------------------------------------------------------
integer (int_kind), dimension(nt), public :: &
tavg_var_tend, & ! tavg id for tracer tendency
tavg_var_tend_zint_100m, & ! vertically integrated tracer tendency, 0-100m
tavg_var_rf_tend ! tavg id for Robert Filter tracer adjustment
integer (int_kind), dimension (3:nt) :: &
tavg_var, & ! tracer
tavg_var_sqr, & ! tracer square
tavg_var_surf, & ! tracer surface value
tavg_var_zint_100m, & ! 0-100m integral of tracer
tavg_var_J, & ! tracer source sink term
tavg_var_Jint, & ! vertically integrated tracer source sink term
tavg_var_Jint_100m, & ! vertically integrated tracer source sink term, 0-100m
tavg_var_stf, & ! surface tracer flux
tavg_var_stf_riv, & ! riverine tracer flux
tavg_var_resid, & ! tracer residual surface flux
tavg_var_fvper, & ! virtual tracer flux from precip,evap,runoff
tavg_var_fvice ! virtual tracer flux from ice formation
!-----------------------------------------------------------------------
! array containing advection type for each passive tracer
!-----------------------------------------------------------------------
character (char_len), dimension(3:nt) :: &
tadvect_ctype_passive_tracers
!-----------------------------------------------------------------------
! PER virtual fluxes. The application of the flux happens in surface
! forcing subroutines, before tavg flags are set, so the tavg accumulation
! must be in a different subroutine than the application. The fluxes
! are stored to avoid recomputing them when accumulating.
!-----------------------------------------------------------------------
real (r8), dimension(:,:,:,:), allocatable :: FvPER
!-----------------------------------------------------------------------
! logical variables that denote if a passive tracer module is on
!-----------------------------------------------------------------------
logical (log_kind) :: &
ecosys_on, cfc_on, sf6_on, iage_on,&
bipit_on, abio_dic_dic14_on, IRF_on
namelist /passive_tracers_on_nml/ &
ecosys_on, cfc_on, sf6_on, iage_on, &
bipit_on, abio_dic_dic14_on, IRF_on
!-----------------------------------------------------------------------
! index bounds of passive tracer module variables in TRACER
!-----------------------------------------------------------------------
integer (int_kind) :: &
ecosys_driver_ind_begin, ecosys_driver_ind_end, &
iage_ind_begin, iage_ind_end, &
bipit_ind_begin, bipit_ind_end, &
cfc_ind_begin, cfc_ind_end, &
sf6_ind_begin, sf6_ind_end, &
abio_dic_dic14_ind_begin, abio_dic_dic14_ind_end, &
IRF_ind_begin, IRF_ind_end
!-----------------------------------------------------------------------
! filtered SST and SSS, if needed
!-----------------------------------------------------------------------
logical (log_kind) :: filtered_SST_SSS_needed
real (r8), dimension(:,:,:), allocatable :: &
SST_FILT, & ! SST with time filter applied, [degC]
SSS_FILT ! SSS with time filter applied, [psu]
real (r8), dimension(:, :, :, :, :), pointer :: &
ecosys_source_sink_3d ! (nx_block, ny_block, km, nt, nblocks_clinic)
!EOC
!***********************************************************************
contains
!***********************************************************************
!BOP
! !IROUTINE: init_passive_tracers
! !INTERFACE:
subroutine init_passive_tracers(init_ts_file_fmt, &
read_restart_filename, errorCode)
! !DESCRIPTION:
! Initialize passive tracers. This involves:
! 1) reading passive_tracers_on_nml to see which module are on
! 2) setting tracer module index bounds
! 3) calling tracer module init subroutine
! 4) define common tavg fields
! 5) set up space for storing virtual fluxes
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
character (*), intent(in) :: &
init_ts_file_fmt, & ! format (bin or nc) for input file
read_restart_filename ! file name for restart file
! !OUTPUT PARAMETERS:
integer (POP_i4), intent(out) :: &
errorCode
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
character(*), parameter :: subname = 'passive_tracers:init_passive_tracers'
integer (int_kind) :: cumulative_nt, n, &
nml_error, &! error flag for nml read
iostat ! io status flag
character (char_len) :: sname, lname, units, coordinates
character (4) :: grid_loc
!-----------------------------------------------------------------------
if (.not. registry_match('init_ts')) then
call exit_POP(sigAbort, 'init_ts not called ' /&
&/ 'before init_passive_tracers. This is necessary for ' /&
&/ 'init_passive_tracers to have correct read_restart_filename')
end if
!-----------------------------------------------------------------------
! register init_passive_tracers
!-----------------------------------------------------------------------
errorCode = POP_Success
call register_string('init_passive_tracers')
ecosys_on = .false.
cfc_on = .false.
sf6_on = .false.
iage_on = .false.
bipit_on = .false.
abio_dic_dic14_on = .false.
IRF_on = .false.
if (my_task == master_task) then
open (nml_in, file=nml_filename, status='old', iostat=nml_error)
if (nml_error /= 0) then
nml_error = -1
else
nml_error = 1
endif
!*** keep reading until find right namelist
do while (nml_error > 0)
read(nml_in, nml=passive_tracers_on_nml,iostat=nml_error)
end do
if (nml_error == 0) close(nml_in)
end if
call broadcast_scalar(nml_error, master_task)
if (nml_error /= 0) then
call exit_POP(sigAbort,'ERROR reading passive_tracers_on namelist')
endif
if (my_task == master_task) then
write(stdout,*) ' '
write(stdout,*) ' Document Namelist Parameters:'
write(stdout,*) ' ============================ '
write(stdout,*) ' '
write(stdout, passive_tracers_on_nml)
write(stdout,*) ' '
call POP_IOUnitsFlush(POP_stdout)
endif
call broadcast_scalar(ecosys_on, master_task)
call broadcast_scalar(cfc_on, master_task)
call broadcast_scalar(sf6_on, master_task)
call broadcast_scalar(iage_on, master_task)
call broadcast_scalar(bipit_on, master_task)
call broadcast_scalar(abio_dic_dic14_on, master_task)
call broadcast_scalar(IRF_on, master_task)
!-----------------------------------------------------------------------
! check for modules that require the flux coupler
!-----------------------------------------------------------------------
if (cfc_on .and. .not. registry_match('lcoupled')) then
call exit_POP(sigAbort,'cfc module requires the flux coupler')
end if
if (sf6_on .and. .not. registry_match('lcoupled')) then
call exit_POP(sigAbort,'sf6 module requires the flux coupler')
end if
if (abio_dic_dic14_on .and. .not. registry_match('lcoupled')) then
call exit_POP(sigAbort,'Abiotic DIC_DIC14 module requires the flux coupler')
end if
!-----------------------------------------------------------------------
! default is for tracers to use same advection scheme as the base model
!-----------------------------------------------------------------------
tadvect_ctype_passive_tracers(3:nt) = 'base_model'
!-----------------------------------------------------------------------
! set up indices for passive tracer modules that are on
!-----------------------------------------------------------------------
cumulative_nt = 2
if (ecosys_on) then
call set_tracer_indices('ECOSYS_DRIVER', ecosys_tracer_cnt, cumulative_nt, &
ecosys_driver_ind_begin, ecosys_driver_ind_end)
end if
if (cfc_on) then
call set_tracer_indices('CFC', cfc_tracer_cnt, cumulative_nt, &
cfc_ind_begin, cfc_ind_end)
end if
if (sf6_on) then
call set_tracer_indices('SF6', sf6_tracer_cnt, cumulative_nt, &
sf6_ind_begin, sf6_ind_end)
end if
if (iage_on) then
call set_tracer_indices('IAGE', iage_tracer_cnt, cumulative_nt, &
iage_ind_begin, iage_ind_end)
end if
if (bipit_on) then
call set_tracer_indices('BIPIT', bipit_tracer_cnt, cumulative_nt, &
bipit_ind_begin, bipit_ind_end)
end if
if (abio_dic_dic14_on) then
call set_tracer_indices('ABIO', abio_dic_dic14_tracer_cnt, cumulative_nt, &
abio_dic_dic14_ind_begin, abio_dic_dic14_ind_end)
end if
if (IRF_on) then
call set_tracer_indices('IRF', IRF_tracer_cnt, cumulative_nt, &
IRF_ind_begin, IRF_ind_end)
end if
if (cumulative_nt /= nt) then
call document(subname, 'nt', nt)
call document(subname, 'cumulative_nt', cumulative_nt)
call exit_POP(sigAbort, &
'ERROR in init_passive_tracers: declared nt does not match cumulative nt')
end if
!-----------------------------------------------------------------------
! by default, all tracers are written to tavg as full depth
!-----------------------------------------------------------------------
tracer_d(1:nt)%lfull_depth_tavg = .true.
!-----------------------------------------------------------------------
! by default, all tracers have scale_factor equal to one
!-----------------------------------------------------------------------
tracer_d(3:nt)%scale_factor = 1.0_POP_r8
! FIXME (mnl, mvertens) -- for completeness, Mariana wants tracer_d
! initialized in ecosys_driver for the ecosystem tracers, which would
! lead to the other tracer modules (iage, cfc, IRF, abio) also
! needing to initialize lfull_depth_tavg and scale_factor rather than
! counting on it being done in passive_tracers.
!-----------------------------------------------------------------------
! ECOSYS DRIVER block
!-----------------------------------------------------------------------
if (ecosys_on) then
call ecosys_driver_init( &
ecosys_driver_ind_begin, &
init_ts_file_fmt, &
read_restart_filename, &
tracer_d(ecosys_driver_ind_begin:ecosys_driver_ind_end), &
TRACER(:,:,:,ecosys_driver_ind_begin:ecosys_driver_ind_end,:,:), &
tadvect_ctype_passive_tracers(ecosys_driver_ind_begin:ecosys_driver_ind_end), &
lhas_riv_flux(ecosys_driver_ind_begin:ecosys_driver_ind_end), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in ecosys_driver_init')
return
endif
allocate(ecosys_source_sink_3d(nx_block, ny_block, km, nt, nblocks_clinic))
ecosys_source_sink_3d = c0
end if
!-----------------------------------------------------------------------
! CFC block
!-----------------------------------------------------------------------
if (cfc_on) then
call cfc_init(cfc_ind_begin, init_ts_file_fmt, read_restart_filename, &
tracer_d(cfc_ind_begin:cfc_ind_end), &
TRACER(:,:,:,cfc_ind_begin:cfc_ind_end,:,:), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in cfc_init')
return
endif
end if
!-----------------------------------------------------------------------
! SF6 block
!-----------------------------------------------------------------------
if (sf6_on) then
call sf6_init(sf6_ind_begin, init_ts_file_fmt, read_restart_filename, &
tracer_d(sf6_ind_begin:sf6_ind_end), &
TRACER(:,:,:,sf6_ind_begin:sf6_ind_end,:,:), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in sf6_init')
return
endif
end if
!-----------------------------------------------------------------------
! Ideal Age (IAGE) block
!-----------------------------------------------------------------------
if (iage_on) then
call iage_init(iage_ind_begin, init_ts_file_fmt, read_restart_filename, &
tracer_d(iage_ind_begin:iage_ind_end), &
TRACER(:,:,:,iage_ind_begin:iage_ind_end,:,:), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in iage_init')
return
endif
end if
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! BIPIT block
!-----------------------------------------------------------------------
if (bipit_on) then
call bipit_init(bipit_ind_begin, init_ts_file_fmt, read_restart_filename, &
tracer_d(bipit_ind_begin:bipit_ind_end), &
TRACER(:,:,:,bipit_ind_begin:bipit_ind_end,:,:), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in bipit_init')
return
endif
end if
!----------------------------------------------------------------------
! ABIO DIC & DIC14 block
!-----------------------------------------------------------------------
if (abio_dic_dic14_on) then
call abio_dic_dic14_init(abio_dic_dic14_ind_begin, init_ts_file_fmt, read_restart_filename, &
tracer_d(abio_dic_dic14_ind_begin:abio_dic_dic14_ind_end), &
TRACER(:,:,:,abio_dic_dic14_ind_begin:abio_dic_dic14_ind_end,:,:), &
errorCode)
if (errorCode /= POP_Success) then
call POP_ErrorSet(errorCode, &
'init_passive_tracers: error in abio_dic_dic14_init')
return
endif
end if
!-----------------------------------------------------------------------
! IRF (IRF) block
!-----------------------------------------------------------------------
if (IRF_on) then
call IRF_init(tracer_d(IRF_ind_begin:IRF_ind_end), &
TRACER(:,:,:,IRF_ind_begin:IRF_ind_end,:,:))
end if
!-----------------------------------------------------------------------
! print out tracer names from tracer modules that are on
!-----------------------------------------------------------------------
if (my_task == master_task) then
write(stdout,delim_fmt)
write(stdout,*) 'TRACER INDEX TRACER NAME'
write(stdout,1010) 1, 'TEMP'
write(stdout,1010) 2, 'SALT'
call POP_IOUnitsFlush(POP_stdout)
do n = 3, nt
write(stdout,1010) n, TRIM(tracer_d(n)%long_name)
call POP_IOUnitsFlush(POP_stdout)
enddo
write(stdout,delim_fmt)
call POP_IOUnitsFlush(POP_stdout)
end if
!-----------------------------------------------------------------------
! set lhas_vflux for passive tracers
!-----------------------------------------------------------------------
do n = 3, nt
lhas_vflux(n) = tracer_ref_val(n) /= c0
enddo
!-----------------------------------------------------------------------
! generate common tavg fields for all tracers
!-----------------------------------------------------------------------
do n = 3, nt
sname = tracer_d(n)%short_name
lname = tracer_d(n)%long_name
units = tracer_d(n)%units
if (tracer_d(n)%lfull_depth_tavg) then
grid_loc = '3111'
coordinates = 'TLONG TLAT z_t time'
else
grid_loc = '3114'
coordinates = 'TLONG TLAT z_t_150m time'
end if
call define_tavg_field(tavg_var(n), &
sname, 3, long_name=lname, &
units=units, grid_loc=grid_loc, &
scale_factor=tracer_d(n)%scale_factor, &
coordinates=coordinates)
sname = trim(tracer_d(n)%short_name) /&
&/ '_SQR'
lname = trim(tracer_d(n)%long_name) /&
&/ ' Squared'
units = '(' /&
&/ trim(tracer_d(n)%units) /&
&/ ')^2'
call define_tavg_field(tavg_var_sqr(n), &
sname, 3, long_name=lname, &
units=units, grid_loc=grid_loc, &
scale_factor=tracer_d(n)%scale_factor**2,&
coordinates=coordinates)
sname = trim(tracer_d(n)%short_name) /&
&/ '_SURF'
lname = trim(tracer_d(n)%long_name) /&
&/ ' Surface Value'
units = tracer_d(n)%units
call define_tavg_field(tavg_var_surf(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = trim(tracer_d(n)%short_name) /&
&/ '_zint_100m'
lname = trim(tracer_d(n)%long_name) /&
&/ ' 0-100m Vertical Integral'
units = trim(tracer_d(n)%units) /&
&/ ' cm'
call define_tavg_field(tavg_var_zint_100m(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = 'J_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Source Sink Term'
units = tracer_d(n)%tend_units
call define_tavg_field(tavg_var_J(n), &
sname, 3, long_name=lname, &
units=units, grid_loc=grid_loc, &
scale_factor=tracer_d(n)%scale_factor, &
coordinates=coordinates)
sname = 'Jint_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Source Sink Term Vertical Integral'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_Jint(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = 'Jint_100m_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Source Sink Term Vertical Integral, 0-100m'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_Jint_100m(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = 'STF_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Surface Flux, excludes FvICE term'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_stf(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
if (lhas_riv_flux(n)) then
sname = trim(tracer_d(n)%short_name) /&
&/ '_RIV_FLUX'
lname = trim(tracer_d(n)%long_name) /&
&/ ' Riverine Flux'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_stf_riv(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
endif
sname = 'RESID_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Residual Surface Flux'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_resid(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
if (lhas_vflux(n)) then
sname = 'FvPER_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Virtual Surface Flux, PER'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_fvper(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = 'FvICE_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Virtual Surface Flux, ICE'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_fvice(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
tavg_method=tavg_method_qflux, &
coordinates='TLONG TLAT time')
endif
enddo
do n=1,nt
sname = 'TEND_' /&
&/ trim(tracer_d(n)%short_name)
lname = 'Tendency of Thickness Weighted '/&
&/ trim(tracer_d(n)%short_name)
units = tracer_d(n)%tend_units
if (tracer_d(n)%lfull_depth_tavg) then
grid_loc = '3111'
coordinates = 'TLONG TLAT z_t time'
else
grid_loc = '3114'
coordinates = 'TLONG TLAT z_t_150m time'
end if
call define_tavg_field(tavg_var_tend(n), &
sname, 3, long_name=lname, &
units=units, grid_loc=grid_loc, &
scale_factor=tracer_d(n)%scale_factor, &
coordinates=coordinates)
sname = 'tend_zint_100m_' /&
&/ trim(tracer_d(n)%short_name)
lname = trim(tracer_d(n)%long_name) /&
&/ ' Tendency Vertical Integral, 0-100m'
units = tracer_d(n)%flux_units
call define_tavg_field(tavg_var_tend_zint_100m(n), &
sname, 2, long_name=lname, &
units=units, grid_loc='2110', &
scale_factor=tracer_d(n)%scale_factor, &
coordinates='TLONG TLAT time')
sname = 'RF_TEND_' /&
&/ trim(tracer_d(n)%short_name)
lname = 'Robert Filter Tendency for '/&
&/ trim(tracer_d(n)%short_name)
units = tracer_d(n)%tend_units
call define_tavg_field(tavg_var_rf_tend(n), &
sname, 3, long_name=lname, &
units=units, grid_loc=grid_loc, &
scale_factor=tracer_d(n)%scale_factor, &
coordinates=coordinates)
end do
!-----------------------------------------------------------------------
! allocate and initialize storage for virtual fluxes
!-----------------------------------------------------------------------
allocate(FvPER(nx_block,ny_block,3:nt,nblocks_clinic))
FvPER = c0
!-----------------------------------------------------------------------
! allocate space for filtered SST and SSS, if needed
!-----------------------------------------------------------------------
filtered_SST_SSS_needed = ecosys_on .or. cfc_on .or. sf6_on .or. &
abio_dic_dic14_on
if (filtered_SST_SSS_needed) then
allocate(SST_FILT(nx_block,ny_block,max_blocks_clinic), &
SSS_FILT(nx_block,ny_block,max_blocks_clinic))
endif
1010 format(5X,I2,10X,A)
!-----------------------------------------------------------------------
!EOC
end subroutine init_passive_tracers
!***********************************************************************
!BOP
! !IROUTINE: set_interior_passive_tracers
! !INTERFACE:
subroutine set_interior_passive_tracers(k, this_block, TRACER_SOURCE)
! !DESCRIPTION:
! call subroutines for each tracer module that compute source-sink terms
! accumulate commnon tavg fields related to source-sink terms
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
integer (int_kind), intent(in) :: k ! vertical level index
type (block), intent(in) :: &
this_block ! block information for this block
! !INPUT/OUTPUT PARAMETERS:
real (r8), dimension(nx_block,ny_block,nt), intent(inout) :: &
TRACER_SOURCE
!EOP
!BOC
!-----------------------------------------------------------------------
! local variables
!-----------------------------------------------------------------------
integer (int_kind) :: &
bid, &! local block address for this block
n ! tracer index
real (r8) :: &
ztop ! depth of top of cell
real (r8), dimension(nx_block,ny_block) :: &
WORK
!-----------------------------------------------------------------------
bid = this_block%local_id
!-----------------------------------------------------------------------
! ECOSYS DRIVER block is done as part of
! set_interior_passive_tracers_3D. Here we are just unpacking the 3D
! structure into the 2D
! -----------------------------------------------------------------------
if (ecosys_on) then
call ecosys_driver_unpack_source_sink_terms( &
ecosys_source_sink_3d(:, :, k, ecosys_driver_ind_begin:ecosys_driver_ind_end, bid), &
TRACER_SOURCE(:, :, ecosys_driver_ind_begin:ecosys_driver_ind_end))
endif
!-----------------------------------------------------------------------
! CFC does not have source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! SF6 does not have source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! Ideal Age (IAGE) block
!-----------------------------------------------------------------------
if (iage_on) then
call iage_set_interior(k, &
TRACER_SOURCE (:,:,iage_ind_begin:iage_ind_end) )
end if
!-----------------------------------------------------------------------
! BIPIT block
!-----------------------------------------------------------------------
if (bipit_on) then
call bipit_set_interior(k, &
TRACER_SOURCE (:,:,bipit_ind_begin:bipit_ind_end),bid,TRACER(:,:,:,bipit_ind_begin:bipit_ind_end,curtime,bid) )
end if
!-----------------------------------------------------------------------
! ABIO DIC & DIC14 block
!-----------------------------------------------------------------------
if (abio_dic_dic14_on) then
call abio_dic_dic14_set_interior(k, &
TRACER(:,:,:,abio_dic_dic14_ind_begin:abio_dic_dic14_ind_end,oldtime,bid),&
TRACER(:,:,:,abio_dic_dic14_ind_begin:abio_dic_dic14_ind_end,curtime,bid),&
TRACER_SOURCE(:,:,abio_dic_dic14_ind_begin:abio_dic_dic14_ind_end), &
this_block)
end if
!-----------------------------------------------------------------------
! IRF does not have source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! accumulate time average if necessary
!-----------------------------------------------------------------------
if (mix_pass /= 1) then
do n = 3, nt
call accumulate_tavg_field(TRACER_SOURCE(:,:,n),tavg_var_J(n),bid,k)
if (accumulate_tavg_now(tavg_var_Jint(n))) then
if (partial_bottom_cells) then
WORK = merge(DZT(:,:,k,bid) * TRACER_SOURCE(:,:,n), &
c0, k<=KMT(:,:,bid))
else
WORK = merge(dz(k) * TRACER_SOURCE(:,:,n), &
c0, k<=KMT(:,:,bid))
endif
call accumulate_tavg_field(WORK,tavg_var_Jint(n),bid,k)
endif
enddo
ztop = c0
if (k > 1) ztop = zw(k-1)
if (ztop < 100.0e2_r8) then
do n = 3, nt
if (accumulate_tavg_now(tavg_var_Jint_100m(n))) then
if (partial_bottom_cells) then
WORK = merge(min(100.0e2_r8 - ztop, DZT(:,:,k,bid)) &
* TRACER_SOURCE(:,:,n), c0, k<=KMT(:,:,bid))
else
WORK = merge(min(100.0e2_r8 - ztop, dz(k)) &
* TRACER_SOURCE(:,:,n), c0, k<=KMT(:,:,bid))
endif
call accumulate_tavg_field(WORK,tavg_var_Jint_100m(n),bid,k)
endif
enddo
endif
endif
!-----------------------------------------------------------------------
!EOC
end subroutine set_interior_passive_tracers
!***********************************************************************
!BOP
! !IROUTINE: set_interior_passive_tracers_3D
! !INTERFACE:
subroutine set_interior_passive_tracers_3D (TRACER_OLD, TRACER_CUR)
! !DESCRIPTION:
! call subroutines for each tracer module that computes 3D source-sink terms
! accumulate commnon tavg fields related to source-sink terms
!
! !REVISION HISTORY:
! same as module
use domain, only : blocks_clinic
use blocks, only : get_block
! !INPUT PARAMETERS:
real (r8), dimension(nx_block,ny_block,km,nt,max_blocks_clinic), intent(in) :: &
TRACER_OLD, & ! previous timestep tracer tendencies
TRACER_CUR ! new tracer tendencies
! !INPUT/OUTPUT PARAMETERS:
!EOP
!BOC
integer (int_kind) :: iblock ! counter for block loops
type (block) :: this_block ! block information for this block
integer (int_kind) :: bid ! local block address for this block
!-----------------------------------------------------------------------
! ECOSYS DRIVER modules 3D source-sink terms
!-----------------------------------------------------------------------
if (ecosys_on) then
call ecosys_driver_set_global_scalars('interior_tendency')
call ecosys_driver_set_interior_forcing(FRACR_BIN, QSW_RAW_BIN, QSW_BIN)
!$OMP PARALLEL DO PRIVATE(iblock, this_block, bid)
do iblock = 1, nblocks_clinic
this_block = get_block(blocks_clinic(iblock), iblock)
bid = this_block%local_id
call ecosys_driver_set_interior(&
TRACER(:, :, :, ecosys_driver_ind_begin:ecosys_driver_ind_end, oldtime, bid), &
TRACER(:, :, :, ecosys_driver_ind_begin:ecosys_driver_ind_end, curtime, bid), &
ecosys_source_sink_3d(:, :, :, ecosys_driver_ind_begin:ecosys_driver_ind_end, bid), &
this_block)
end do
!$OMP END PARALLEL DO
call ecosys_driver_comp_global_averages('interior_tendency')
end if
!-----------------------------------------------------------------------
! CFC does not compute and store 3D source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! SF6 does not compute and store 3D source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! Ideal Age (IAGE) does not compute and store 3D source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! ABIO DIC & DIC 14 does not compute and store 3D source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! IRF does not compute and store 3D source-sink terms
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
! accumulate time average if necessary
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------