New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bio_medusa_diag_slice.F90 in branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90 @ 8213

Last change on this file since 8213 was 8213, checked in by jpalmier, 7 years ago

JPALM -- split trcbio - mergeable-ish MEDUSA branch

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