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

source: branches/NERC/dev_r5518_GO6_CO2_cmip/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90 @ 13709

Last change on this file since 13709 was 9114, checked in by frrh, 6 years ago

Apply changes developed under Met Office GMED ticket number 351 in development
branch branches/NERC/dev_r5518_GO6_ScalingCoupledChl.

The command issued to perform the merge is:

svn merge -r 8590:9053 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/NERC/dev_r5518_GO6_ScalingCoupledChl

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