source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90 @ 8442

Last change on this file since 8442 was 8442, checked in by frrh, 4 years ago

Commit changes relating to Met Office GMED ticket 340 for the
tidying of MEDUSA related code and debugging statements in the TOP code.

Only code introduced at revision 8434 of branch
http://fcm3/projects/NEMO.xm/log/branches/NERC/dev_r5518_GO6_split_trcbiomedusa
is included here, all previous revisions of that branch having been dealt with
under GMED ticket 339.

File size: 16.2 KB
Line 
1MODULE bio_medusa_diag_slice_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_medusa_diag_slice_mod  ***
4   !! Diagnostic calculations at different levels
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   bio_medusa_diag_slice     ! Called in trcbio_medusa.F90
18
19   !!----------------------------------------------------------------------
20   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
21   !! $Id$
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE bio_medusa_diag_slice( jk )
28      !!---------------------------------------------------------------------
29      !!                     ***  ROUTINE bio_medusa_diag_slice  ***
30      !! This called from TRC_BIO_MEDUSA and
31      !!  - ...
32      !!----------------------------------------------------------------------
33      USE bio_medusa_mod
34      USE par_medusa,        ONLY: jpchd, jpchn     
35      USE dom_oce,           ONLY: tmask
36      USE in_out_manager,    ONLY: lwp, numout
37# if defined key_iomput
38      USE iom,               ONLY: iom_put
39# endif
40      USE lbclnk,            ONLY: lbc_lnk
41      USE trc,               ONLY: trn
42      USE oce,               ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl
43      USE par_oce,           ONLY: jpi, jpj
44      USE sbc_oce,           ONLY: lk_oasis, qsr, wndm
45      USE sms_medusa,        ONLY: i0100, i0150, i0200, i0500, i1000,      &
46                                   f2_ccd_arg, f2_ccd_cal,                 &
47                                   f3_co3, f3_h2co3, f3_hco3, f3_pH,       &
48                                   jdms, ocal_ccd, xpar, xze,              &
49                                   zb_co2_flx, zb_dms_srf,                 &
50                                   zn_co2_flx, zn_dms_srf, zn_chl_srf
51      USE trc,               ONLY: med_diag
52
53      !! The vertical level
54      INTEGER, INTENT( in ) ::    jk
55      !!----------------------------------------------------------------------
56
57      !!-----------------------------------------
58      !!
59      !! 2d specific k level diags
60      !!
61      !!-----------------------------------------
62#   if defined key_debug_medusa
63         IF (lwp) write (numout,*) 'bio_medusa_diag_slice: start jk = ', jk
64         CALL flush(numout)
65#   endif
66      !!
67      IF (jk.eq.1) THEN
68         !! JPALM -- 02-06-2017 --
69         !! add Chl surf coupling
70         !! no need to output, just pass to cpl var
71         IF (lk_oasis) THEN
72            zn_chl_srf(:,:) = (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6  !! surf Chl in Kg-chl/m3 as needed for cpl
73            chloro_out_cpl(:,:) = zn_chl_srf(:,:)        !! Coupling Chl
74         END IF
75         IF( med_diag%MED_QSR%dgsave ) THEN
76            CALL iom_put( "MED_QSR"  , qsr ) !
77         ENDIF
78         IF( med_diag%MED_XPAR%dgsave ) THEN
79            CALL iom_put( "MED_XPAR"  , xpar(:,:,jk) ) !
80         ENDIF       
81         IF( med_diag%OCAL_CCD%dgsave ) THEN
82            CALL iom_put( "OCAL_CCD"  , ocal_ccd ) !
83         ENDIF
84         IF( med_diag%FE_0000%dgsave ) THEN
85            CALL iom_put( "FE_0000"  , xFree ) !
86         ENDIF                     
87         IF( med_diag%MED_XZE%dgsave ) THEN
88            CALL iom_put( "MED_XZE"  , xze ) !
89         ENDIF 
90# if defined key_roam                     
91         IF( med_diag%WIND%dgsave ) THEN
92            CALL iom_put( "WIND"  , wndm )
93         ENDIF
94         IF( med_diag%ATM_PCO2%dgsave ) THEN
95            CALL iom_put( "ATM_PCO2"  , f_pco2a2d )
96            DEALLOCATE( f_pco2a2d )
97         ENDIF
98         IF( med_diag%OCN_PH%dgsave ) THEN
99            zw2d(:,:) = f3_pH(:,:,jk)
100            CALL iom_put( "OCN_PH"  , zw2d )
101         ENDIF
102         IF( med_diag%OCN_PCO2%dgsave ) THEN
103            CALL iom_put( "OCN_PCO2"  , f_pco2w2d )
104            DEALLOCATE( f_pco2w2d )
105         ENDIF
106         IF( med_diag%OCNH2CO3%dgsave ) THEN
107            zw2d(:,:) = f3_h2co3(:,:,jk)
108            CALL iom_put( "OCNH2CO3"  , zw2d )
109         ENDIF
110         IF( med_diag%OCN_HCO3%dgsave ) THEN
111            zw2d(:,:) = f3_hco3(:,:,jk)
112            CALL iom_put( "OCN_HCO3"  , zw2d )
113         ENDIF
114         IF( med_diag%OCN_CO3%dgsave ) THEN
115            zw2d(:,:) = f3_co3(:,:,jk)
116            CALL iom_put( "OCN_CO3"  , zw2d )
117         ENDIF
118         IF( med_diag%CO2FLUX%dgsave ) THEN
119            CALL iom_put( "CO2FLUX"  , f_co2flux2d )
120            DEALLOCATE( f_co2flux2d )
121         ENDIF
122         !!
123         !! AXY (10/11/16): repeat CO2 flux diagnostic in UKMO/CMIP6 units;
124         !!                 this both outputs the CO2 flux in specified units
125         !!                 and sends the resulting field to the coupler
126         !! JPALM (17/11/16): put CO2 flux (fgco2) alloc/unalloc/pass to zn
127         !!                   out of diag list request
128         CALL lbc_lnk( fgco2(:,:),'T',1. )
129         IF( med_diag%FGCO2%dgsave ) THEN
130            CALL iom_put( "FGCO2"  , fgco2 )
131         ENDIF
132         !! JPALM (17/11/16): should mv this fgco2 part
133         !!                   out of lk_iomput loop
134         zb_co2_flx = zn_co2_flx
135         zn_co2_flx = fgco2
136         IF (lk_oasis) THEN
137            CO2Flux_out_cpl = zn_co2_flx
138         ENDIF
139         DEALLOCATE( fgco2 )
140         !! ---
141         IF( med_diag%OM_CAL%dgsave ) THEN
142            CALL iom_put( "OM_CAL"  , f_omcal )
143         ENDIF
144         IF( med_diag%OM_ARG%dgsave ) THEN
145            CALL iom_put( "OM_ARG"  , f_omarg )
146         ENDIF
147         IF( med_diag%TCO2%dgsave ) THEN
148            CALL iom_put( "TCO2"  , f_TDIC2d )
149            DEALLOCATE( f_TDIC2d )
150         ENDIF
151         IF( med_diag%TALK%dgsave ) THEN
152            CALL iom_put( "TALK"  , f_TALK2d )
153            DEALLOCATE( f_TALK2d )
154         ENDIF
155         IF( med_diag%KW660%dgsave ) THEN
156            CALL iom_put( "KW660"  , f_kw6602d )
157            DEALLOCATE( f_kw6602d )
158         ENDIF
159         IF( med_diag%ATM_PP0%dgsave ) THEN
160            CALL iom_put( "ATM_PP0"  , f_pp02d )
161            DEALLOCATE( f_pp02d )
162         ENDIF
163         IF( med_diag%O2FLUX%dgsave ) THEN
164            CALL iom_put( "O2FLUX"  , f_o2flux2d )
165            DEALLOCATE( f_o2flux2d )
166         ENDIF
167         IF( med_diag%O2SAT%dgsave ) THEN
168            CALL iom_put( "O2SAT"  , f_o2sat2d )
169            DEALLOCATE( f_o2sat2d )
170         ENDIF
171         IF( med_diag%CAL_CCD%dgsave ) THEN
172            CALL iom_put( "CAL_CCD"  , f2_ccd_cal )
173         ENDIF
174         IF( med_diag%ARG_CCD%dgsave ) THEN
175            CALL iom_put( "ARG_CCD"  , f2_ccd_arg )
176         ENDIF
177         IF (jdms .eq. 1) THEN
178            IF( med_diag%DMS_SURF%dgsave ) THEN
179               CALL lbc_lnk(dms_surf2d(:,:),'T',1. )
180               CALL iom_put( "DMS_SURF"  , dms_surf2d )
181               zb_dms_srf = zn_dms_srf
182               zn_dms_srf = dms_surf2d
183               IF (lk_oasis) THEN
184                  DMS_out_cpl = zn_dms_srf
185               ENDIF
186               DEALLOCATE( dms_surf2d ) 
187            ENDIF
188            IF( med_diag%DMS_ANDR%dgsave ) THEN
189               CALL iom_put( "DMS_ANDR"  , dms_andr2d )
190               DEALLOCATE( dms_andr2d )
191            ENDIF
192            IF( med_diag%DMS_SIMO%dgsave ) THEN
193               CALL iom_put( "DMS_SIMO"  , dms_simo2d )
194               DEALLOCATE( dms_simo2d )
195            ENDIF
196            IF( med_diag%DMS_ARAN%dgsave ) THEN
197               CALL iom_put( "DMS_ARAN"  , dms_aran2d )
198               DEALLOCATE( dms_aran2d )
199            ENDIF
200            IF( med_diag%DMS_HALL%dgsave ) THEN
201               CALL iom_put( "DMS_HALL"  , dms_hall2d )
202               DEALLOCATE( dms_hall2d )
203            ENDIF
204            IF( med_diag%DMS_ANDM%dgsave ) THEN
205               CALL iom_put( "DMS_ANDM"  , dms_andm2d )
206               DEALLOCATE( dms_andm2d )
207            ENDIF
208         ENDIF
209         !! AXY (24/11/16): extra MOCSY diagnostics
210         IF( med_diag%ATM_XCO2%dgsave ) THEN
211            CALL iom_put( "ATM_XCO2"  ,   f_xco2a_2d      )
212            DEALLOCATE( f_xco2a_2d )
213         ENDIF
214         IF( med_diag%OCN_FCO2%dgsave ) THEN
215            CALL iom_put( "OCN_FCO2"  ,   f_fco2w_2d      )
216            DEALLOCATE( f_fco2w_2d )
217         ENDIF
218         IF( med_diag%ATM_FCO2%dgsave ) THEN
219            CALL iom_put( "ATM_FCO2"  ,   f_fco2a_2d      )
220            DEALLOCATE( f_fco2a_2d )
221         ENDIF
222         IF( med_diag%OCN_RHOSW%dgsave ) THEN
223            CALL iom_put( "OCN_RHOSW"  ,  f_ocnrhosw_2d   )
224            DEALLOCATE( f_ocnrhosw_2d )
225         ENDIF
226         IF( med_diag%OCN_SCHCO2%dgsave ) THEN
227            CALL iom_put( "OCN_SCHCO2"  , f_ocnschco2_2d  )
228            DEALLOCATE( f_ocnschco2_2d )
229         ENDIF
230         IF( med_diag%OCN_KWCO2%dgsave ) THEN
231            CALL iom_put( "OCN_KWCO2"  ,  f_ocnkwco2_2d   )
232            DEALLOCATE( f_ocnkwco2_2d )
233         ENDIF
234         IF( med_diag%OCN_K0%dgsave ) THEN
235            CALL iom_put( "OCN_K0"  ,     f_ocnk0_2d      )
236            DEALLOCATE( f_ocnk0_2d )
237         ENDIF
238         IF( med_diag%CO2STARAIR%dgsave ) THEN
239            CALL iom_put( "CO2STARAIR"  , f_co2starair_2d )
240            DEALLOCATE( f_co2starair_2d )
241         ENDIF
242         IF( med_diag%OCN_DPCO2%dgsave ) THEN
243            CALL iom_put( "OCN_DPCO2"  ,  f_ocndpco2_2d   )
244            DEALLOCATE( f_ocndpco2_2d )
245         ENDIF
246# endif                     
247      ELSE IF (jk.eq.i0100) THEN
248         IF( med_diag%SDT__100%dgsave ) THEN
249            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
250            CALL iom_put( "SDT__100"  , zw2d )
251         ENDIF
252         IF( med_diag%REG__100%dgsave ) THEN
253            CALL iom_put( "REG__100"  , fregen2d )
254         ENDIF
255         IF( med_diag%FDT__100%dgsave ) THEN
256            CALL iom_put( "FDT__100"  , ffastn )
257         ENDIF           
258         IF( med_diag%RG__100F%dgsave ) THEN
259            CALL iom_put( "RG__100F"  , fregenfast )
260         ENDIF
261         IF( med_diag%FDS__100%dgsave ) THEN
262            CALL iom_put( "FDS__100"  , ffastsi )
263         ENDIF         
264         IF( med_diag%RGS_100F%dgsave ) THEN
265            CALL iom_put( "RGS_100F"  , fregenfastsi )
266         ENDIF
267         IF( med_diag%FE_0100%dgsave ) THEN
268            CALL iom_put( "FE_0100"  , xFree )
269         ENDIF
270# if defined key_roam                     
271         IF( med_diag%RR_0100%dgsave ) THEN
272            CALL iom_put( "RR_0100"  , ffastca2d )
273         ENDIF                     
274         IF( med_diag%SDC__100%dgsave ) THEN
275            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
276            CALL iom_put( "SDC__100"  , zw2d )
277         ENDIF                 
278         IF( med_diag%epC100%dgsave    ) THEN
279            zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk)
280            CALL iom_put( "epC100"    , zw2d )
281         ENDIF         
282         IF( med_diag%epCALC100%dgsave ) THEN
283            CALL iom_put( "epCALC100" , ffastca )
284         ENDIF         
285         IF( med_diag%epN100%dgsave    ) THEN
286            zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk)
287            CALL iom_put( "epN100"    , zw2d )
288         ENDIF         
289         IF( med_diag%epSI100%dgsave   ) THEN
290            CALL iom_put( "epSI100"   , ffastsi )
291         ENDIF         
292# endif                     
293      ELSE IF (jk.eq.i0200) THEN
294         IF( med_diag%SDT__200%dgsave ) THEN
295            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
296            CALL iom_put( "SDT__200"  , zw2d )
297         ENDIF
298         IF( med_diag%REG__200%dgsave ) THEN
299            CALL iom_put( "REG__200"  , fregen2d )
300         ENDIF
301         IF( med_diag%FDT__200%dgsave ) THEN
302            CALL iom_put( "FDT__200"  , ffastn )
303         ENDIF
304         IF( med_diag%RG__200F%dgsave ) THEN
305            CALL iom_put( "RG__200F"  , fregenfast )
306         ENDIF
307         IF( med_diag%FDS__200%dgsave ) THEN
308            CALL iom_put( "FDS__200"  , ffastsi )
309         ENDIF
310         IF( med_diag%RGS_200F%dgsave ) THEN
311            CALL iom_put( "RGS_200F"  , fregenfastsi )
312         ENDIF
313         IF( med_diag%FE_0200%dgsave ) THEN
314            CALL iom_put( "FE_0200"   , xFree )
315         ENDIF
316# if defined key_roam                     
317         IF( med_diag%SDC__200%dgsave ) THEN
318            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
319            CALL iom_put( "SDC__200"  , zw2d )
320         ENDIF
321# endif                     
322      ELSE IF (jk.eq.i0500) THEN
323         IF( med_diag%SDT__500%dgsave ) THEN
324            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
325            CALL iom_put( "SDT__500"  , zw2d )
326         ENDIF
327         IF( med_diag%REG__500%dgsave ) THEN
328            CALL iom_put( "REG__500"  , fregen2d )
329         ENDIF     
330         IF( med_diag%FDT__500%dgsave ) THEN
331            CALL iom_put( "FDT__500"  , ffastn )
332         ENDIF
333         IF( med_diag%RG__500F%dgsave ) THEN
334            CALL iom_put( "RG__500F"  , fregenfast )
335         ENDIF
336         IF( med_diag%FDS__500%dgsave ) THEN
337            CALL iom_put( "FDS__500"  , ffastsi )
338         ENDIF
339         IF( med_diag%RGS_500F%dgsave ) THEN
340            CALL iom_put( "RGS_500F"  , fregenfastsi )
341         ENDIF
342         IF( med_diag%FE_0500%dgsave ) THEN
343            CALL iom_put( "FE_0500"  , xFree )
344         ENDIF
345# if defined key_roam                     
346         IF( med_diag%RR_0500%dgsave ) THEN
347            CALL iom_put( "RR_0500"  , ffastca2d )
348         ENDIF
349         IF( med_diag%SDC__500%dgsave ) THEN
350            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
351            CALL iom_put( "SDC__500"  , zw2d )
352         ENDIF 
353# endif                     
354      ELSE IF (jk.eq.i1000) THEN
355         IF( med_diag%SDT_1000%dgsave ) THEN
356            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk)
357            CALL iom_put( "SDT_1000"  , zw2d )
358         ENDIF
359         IF( med_diag%REG_1000%dgsave ) THEN
360            CALL iom_put( "REG_1000"  , fregen2d )
361         ENDIF 
362         IF( med_diag%FDT_1000%dgsave ) THEN
363            CALL iom_put( "FDT_1000"  , ffastn )
364         ENDIF
365         IF( med_diag%RG_1000F%dgsave ) THEN
366            CALL iom_put( "RG_1000F"  , fregenfast )
367         ENDIF
368         IF( med_diag%FDS_1000%dgsave ) THEN
369            CALL iom_put( "FDS_1000"  , ffastsi )
370         ENDIF
371         IF( med_diag%RGS1000F%dgsave ) THEN
372            CALL iom_put( "RGS1000F"  , fregenfastsi )
373         ENDIF
374         IF( med_diag%FE_1000%dgsave ) THEN
375            CALL iom_put( "FE_1000"  , xFree )
376         ENDIF
377# if defined key_roam                     
378         IF( med_diag%RR_1000%dgsave ) THEN
379            CALL iom_put( "RR_1000"  , ffastca2d )
380            DEALLOCATE( ffastca2d )
381         ENDIF
382         IF( med_diag%SDC_1000%dgsave ) THEN
383            zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk)
384            CALL iom_put( "SDC_1000"  , zw2d )
385         ENDIF 
386# endif                     
387      ENDIF
388      !! to do on every k loop :
389      IF( med_diag%DETFLUX3%dgsave ) THEN
390         !! detrital flux
391         detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk)
392         !CALL iom_put( "DETFLUX3"  , ftot_n )
393      ENDIF
394# if defined key_roam                     
395      IF( med_diag%EXPC3%dgsave ) THEN
396         expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk)
397      ENDIF         
398      IF( med_diag%EXPN3%dgsave ) THEN
399         expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk)
400      ENDIF         
401# endif         
402#   if defined key_debug_medusa
403         IF (lwp) write (numout,*) 'bio_medusa_diag_slice: end jk = ', jk
404         CALL flush(numout)
405#   endif
406
407   END SUBROUTINE bio_medusa_diag_slice
408
409#else
410   !!======================================================================
411   !!  Dummy module :                                   No MEDUSA bio-model
412   !!======================================================================
413CONTAINS
414   SUBROUTINE bio_medusa_diag_slice( )                  ! Empty routine
415      WRITE(*,*) 'bio_medusa_diag_slice: You should not have seen this print! error?'
416   END SUBROUTINE bio_medusa_diag_slice
417#endif 
418
419   !!======================================================================
420END MODULE bio_medusa_diag_slice_mod
Note: See TracBrowser for help on using the repository browser.