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 @ 8076

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

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