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/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90 @ 7927

Last change on this file since 7927 was 7927, checked in by marc, 7 years ago

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