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.
Changeset 8442 for branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

Ignore:
Timestamp:
2017-08-17T13:39:18+02:00 (7 years ago)
Author:
frrh
Message:

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.

Location:
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA
Files:
2 deleted
11 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90

    r8441 r8442  
    124124      !! Air-sea gas exchange 
    125125      !!----------------------------------------------------------- 
     126 
     127#   if defined key_debug_medusa 
     128               IF (lwp) write (numout,*)                     &  
     129               'air-sea: gas_transfer kt = ', kt 
     130               CALL flush(numout) 
     131#   endif 
    126132      DO jj = 2,jpjm1 
    127133         DO ji = 2,jpim1 
    … …  
    145151               !!                 Wanninkhof (2014), option 7 
    146152               !! 
     153               CALL gas_transfer( wndm(ji,jj), 1, 7,         &  ! inputs 
     154                                  f_kw660(ji,jj) )              ! outputs 
     155            ENDIF 
     156         ENDDO 
     157      ENDDO 
     158 
    147159#   if defined key_debug_medusa 
    148                IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 
     160               IF (lwp) write (numout,*)                     & 
     161               'air-sea: carb-chem kt = ', kt 
    149162               CALL flush(numout) 
    150163#   endif 
    151                CALL gas_transfer( wndm(ji,jj), 1, 7,         &  ! inputs 
    152                                   f_kw660(ji,jj) )              ! outputs 
    153 #   if defined key_debug_medusa 
    154                IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 
    155                CALL flush(numout) 
    156 #   endif 
    157             ENDIF 
    158          ENDDO 
    159       ENDDO 
    160  
    161164      DO jj = 2,jpjm1 
    162165         DO ji = 2,jpim1 
    … …  
    228231               !!                 failure position can be determined 
    229232               if (iters .eq. 25) then 
    230                   IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 
     233                  IF(lwp) WRITE(numout,*) 'air-sea: ITERS WARNING, ',      & 
    231234                     iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 
    232235               endif 
    … …  
    335338                                         hmld(ji,jj),qsr(ji,jj),              & 
    336339                                         zdin(ji,jj), dms_nlim(ji,jj),        & 
    337                                          dms_andr(ji,jj),dms_simo(ji,jj),     & 
    338                                          dms_aran(ji,jj),dms_hall(ji,jj),     & 
    339                                          dms_andm(ji,jj)) 
     340                                         dms_andr,dms_simo,dms_aran,dms_hall, &  
     341                                         dms_andm) 
    340342                  else 
    341343                     !! use diel-average inputs 
    … …  
    346348                                         zn_dms_mld(ji,jj),zn_dms_qsr(ji,jj), & 
    347349                                         zn_dms_din(ji,jj),dms_nlim(ji,jj),   & 
    348                                          dms_andr(ji,jj),dms_simo(ji,jj),     & 
    349                                          dms_aran(ji,jj),dms_hall(ji,jj),     & 
    350                                          dms_andm(ji,jj)) 
     350                                         dms_andr,dms_simo,dms_aran,dms_hall, &  
     351                                         dms_andm) 
    351352                  endif 
    352353                  !! 
    353354                  !! assign correct output to variable passed to atmosphere 
    354355                  if (jdms_model .eq. 1) then 
    355                      dms_surf(ji,jj) = dms_andr(ji,jj) 
     356                     dms_surf = dms_andr 
    356357                  elseif (jdms_model .eq. 2) then 
    357                      dms_surf(ji,jj) = dms_simo(ji,jj) 
     358                     dms_surf = dms_simo 
    358359                  elseif (jdms_model .eq. 3) then 
    359                      dms_surf(ji,jj) = dms_aran(ji,jj) 
     360                     dms_surf = dms_aran 
    360361                  elseif (jdms_model .eq. 4) then 
    361                      dms_surf(ji,jj) = dms_hall(ji,jj) 
     362                     dms_surf = dms_hall 
    362363                  elseif (jdms_model .eq. 5) then 
    363                      dms_surf(ji,jj) = dms_andm(ji,jj) 
     364                     dms_surf = dms_andm 
    364365                  endif 
    365366                  !! 
    366367                  !! 2D diag through iom_use 
    367                   IF( lk_iomput ) THEN 
    368                      IF( med_diag%DMS_SURF%dgsave ) THEN 
    369                         dms_surf2d(ji,jj) = dms_surf(ji,jj) 
    370                      ENDIF 
    371                      IF( med_diag%DMS_ANDR%dgsave ) THEN 
    372                         dms_andr2d(ji,jj) = dms_andr(ji,jj) 
    373                      ENDIF 
    374                      IF( med_diag%DMS_SIMO%dgsave ) THEN 
    375                         dms_simo2d(ji,jj) = dms_simo(ji,jj) 
    376                      ENDIF 
    377                      IF( med_diag%DMS_ARAN%dgsave ) THEN 
    378                         dms_aran2d(ji,jj) = dms_aran(ji,jj) 
    379                      ENDIF 
    380                      IF( med_diag%DMS_HALL%dgsave ) THEN 
    381                         dms_hall2d(ji,jj) = dms_hall(ji,jj) 
    382                      ENDIF  
    383                      IF( med_diag%DMS_ANDM%dgsave ) THEN  
    384                         dms_andm2d(ji,jj) = dms_andm(ji,jj)  
    385                      ENDIF 
    386 #   if defined key_debug_medusa 
    387                      IF (lwp) write (numout,*)                                & 
    388                         'trc_bio_medusa: finish calculating dms' 
    389                      CALL flush(numout) 
    390 #   endif  
    391                   ENDIF      !! End iom 
     368                  IF( med_diag%DMS_SURF%dgsave ) THEN 
     369                     dms_surf2d(ji,jj) = dms_surf 
     370                  ENDIF 
     371                  IF( med_diag%DMS_ANDR%dgsave ) THEN 
     372                     dms_andr2d(ji,jj) = dms_andr 
     373                  ENDIF 
     374                  IF( med_diag%DMS_SIMO%dgsave ) THEN 
     375                     dms_simo2d(ji,jj) = dms_simo 
     376                  ENDIF 
     377                  IF( med_diag%DMS_ARAN%dgsave ) THEN 
     378                     dms_aran2d(ji,jj) = dms_aran 
     379                  ENDIF 
     380                  IF( med_diag%DMS_HALL%dgsave ) THEN 
     381                     dms_hall2d(ji,jj) = dms_hall 
     382                  ENDIF  
     383                  IF( med_diag%DMS_ANDM%dgsave ) THEN  
     384                     dms_andm2d(ji,jj) = dms_andm 
     385                  ENDIF 
    392386               ENDIF 
    393387            ENDDO 
    394388         ENDDO 
     389#   if defined key_debug_medusa 
     390         IF (lwp) write (numout,*)                                & 
     391            'air-sea: finish calculating dms kt = ',kt 
     392            CALL flush(numout) 
     393#   endif  
    395394      ENDIF                  !! End IF (jdms == 1) 
    396  
    397395 
    398396      !! 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_iomput.F90

    r8441 r8442  
    6161#   if defined key_debug_medusa 
    6262               IF (lwp) write (numout,*)                                     & 
    63                   'trc_bio_medusa: diag in ij-jj-jk loop' 
     63                  'bio_med_diag_iomput: in ij-jj loop jk = ', jk 
    6464               CALL flush(numout) 
    6565#   endif 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag.F90

    r8441 r8442  
    3131      !!------------------------------------------------------------------- 
    3232      USE bio_med_diag_iomput_mod,  ONLY: bio_med_diag_iomput 
    33       USE bio_med_diag_trc_mod,     ONLY: bio_med_diag_trc 
    3433      USE bio_medusa_mod 
    3534      USE dom_oce,                  ONLY: e3t_0, e3t_n,                  & 
    … …  
    4241      USE sms_medusa,               ONLY: xrfn, xthetapd, xthetapn,      & 
    4342                                          xthetazme, xthetazmi 
    44       USE trc,                      ONLY: ln_diatrc, med_diag  
     43      USE trc,                      ONLY: med_diag  
    4544# if defined key_roam 
    4645      USE trcoxy_medusa,            ONLY: oxy_sato 
    … …  
    193192# endif 
    194193 
    195       IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
    196  
    197          !!--------------------------------------------------------------- 
    198          !! Calculates the diagnostics used with iom_put 
    199          !!--------------------------------------------------------------- 
    200          CALL bio_med_diag_iomput( jk ) 
    201  
    202       ELSE IF( ln_diatrc ) THEN 
    203  
    204          !!--------------------------------------------------------------- 
    205          !! The diagnostics without using iom_use 
    206          !!--------------------------------------------------------------- 
    207          CALL bio_med_diag_trc( jk ) 
    208  
    209       ENDIF 
     194      !!--------------------------------------------------------------- 
     195      !! Calculates the diagnostics used with iom_put 
     196      !!--------------------------------------------------------------- 
     197      CALL bio_med_diag_iomput( jk ) 
    210198 
    211199   END SUBROUTINE bio_medusa_diag 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90

    r8441 r8442  
    6060      !! 
    6161      !!----------------------------------------- 
    62       IF (jk.eq.1) THEN 
    6362#   if defined key_debug_medusa 
    64          IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1' 
     63         IF (lwp) write (numout,*) 'bio_medusa_diag_slice: start jk = ', jk 
    6564         CALL flush(numout) 
    6665#   endif 
     66      !! 
     67      IF (jk.eq.1) THEN 
    6768         !! JPALM -- 02-06-2017 -- 
    6869         !! add Chl surf coupling 
    … …  
    245246# endif                      
    246247      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 
    251248         IF( med_diag%SDT__100%dgsave ) THEN 
    252249            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    … …  
    293290            CALL iom_put( "epSI100"   , ffastsi ) 
    294291         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 
    300292# endif                      
    301293      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 
    306294         IF( med_diag%SDT__200%dgsave ) THEN 
    307295            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    … …  
    333321# endif                      
    334322      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 
    339323         IF( med_diag%SDT__500%dgsave ) THEN 
    340324            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    … …  
    369353# endif                       
    370354      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 
    375355         IF( med_diag%SDT_1000%dgsave ) THEN 
    376356            zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 
    … …  
    420400      ENDIF          
    421401# 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 
    422406 
    423407   END SUBROUTINE bio_medusa_diag_slice 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_fin.F90

    r8441 r8442  
    5151                                   zn_sed_c, zn_sed_ca, zn_sed_fe,      & 
    5252                                   zn_sed_n, zn_sed_si 
    53       USE trc,               ONLY: ctrc2d, ctrc3d, ln_diatrc,           & 
    54                                    med_diag, nittrc000,                 & 
    55                                    trbio, trc2d, trc3d 
     53      USE trc,               ONLY: med_diag, nittrc000  
    5654      USE trcnam_trp,        ONLY: ln_trcadv_cen2, ln_trcadv_tvd 
    5755  
    … …  
    10098         zn_sed_ca(:,:) = za_sed_ca(:,:) 
    10199      endif 
    102       IF( ln_diatrc ) THEN 
    103          DO jj = 2,jpjm1 
    104             DO ji = 2,jpim1 
    105                trc2d(ji,jj,131) = za_sed_n(ji,jj) 
    106                trc2d(ji,jj,132) = za_sed_fe(ji,jj) 
    107                trc2d(ji,jj,133) = za_sed_c(ji,jj) 
    108                trc2d(ji,jj,134) = za_sed_si(ji,jj) 
    109                trc2d(ji,jj,135) = za_sed_ca(ji,jj) 
    110             ENDDO 
    111          ENDDO 
    112          !! AXY (07/07/15): temporary hijacking 
    113 # if defined key_roam 
    114   !!       trc2d(:,:,126) = zn_dms_chn(:,:) 
    115   !!       trc2d(:,:,127) = zn_dms_chd(:,:) 
    116   !!       trc2d(:,:,128) = zn_dms_mld(:,:) 
    117   !!       trc2d(:,:,129) = zn_dms_qsr(:,:) 
    118   !!       trc2d(:,:,130) = zn_dms_din(:,:) 
    119 # endif 
    120       ENDIF  
    121100      !! 
    122101      if (ibenthic.eq.2) then 
    … …  
    238217         ENDIF 
    239218      endif 
    240       
     219 
    241220#  if defined key_debug_medusa 
    242221         !! AXY (12/07/17) 
    … …  
    279258               ENDIF 
    280259            ENDDO 
    281          ENDDO 
     260         ENDDO    
    282261         !! silicon 
    283262         DO jj = 2,jpjm1 
    … …  
    292271               ENDIF 
    293272            ENDDO 
    294          ENDDO 
     273         ENDDO    
    295274         !! carbon 
    296275         DO jj = 2,jpjm1 
    … …  
    306285               ENDIF 
    307286            ENDDO 
    308          ENDDO 
     287         ENDDO    
    309288         !! alkalinity 
    310289         DO jj = 2,jpjm1 
    … …  
    319298               ENDIF 
    320299            ENDDO 
    321          ENDDO 
     300         ENDDO    
    322301#  endif 
    323   
    324       IF( ln_diatrc ) THEN 
    325          !!----------------------------------------------------------------- 
    326          !! Output several accumulated diagnostics 
    327          !!   - biomass-average phytoplankton limitation terms 
    328          !!   - integrated tendency terms 
    329          !!----------------------------------------------------------------- 
    330          !!  
    331          DO jj = 2,jpjm1 
    332             DO ji = 2,jpim1 
    333                !! non-diatom phytoplankton limitations 
    334                trc2d(ji,jj,25)  = trc2d(ji,jj,25) / MAX(ftot_pn(ji,jj), rsmall) 
    335                trc2d(ji,jj,26)  = trc2d(ji,jj,26) / MAX(ftot_pn(ji,jj), rsmall) 
    336                trc2d(ji,jj,27)  = trc2d(ji,jj,27) / MAX(ftot_pn(ji,jj), rsmall) 
    337                !! diatom phytoplankton limitations 
    338                trc2d(ji,jj,28)  = trc2d(ji,jj,28) / MAX(ftot_pd(ji,jj), rsmall) 
    339                trc2d(ji,jj,29)  = trc2d(ji,jj,29) / MAX(ftot_pd(ji,jj), rsmall) 
    340                trc2d(ji,jj,30)  = trc2d(ji,jj,30) / MAX(ftot_pd(ji,jj), rsmall) 
    341                trc2d(ji,jj,31)  = trc2d(ji,jj,31) / MAX(ftot_pd(ji,jj), rsmall) 
    342                trc2d(ji,jj,32)  = trc2d(ji,jj,32) / MAX(ftot_pd(ji,jj), rsmall) 
    343                !! tendency terms 
    344                trc2d(ji,jj,76)  = fflx_n(ji,jj) 
    345                trc2d(ji,jj,77)  = fflx_si(ji,jj) 
    346                trc2d(ji,jj,78)  = fflx_fe(ji,jj) 
    347                !! Integrated biomass. 
    348                !! integrated non-diatom phytoplankton 
    349                trc2d(ji,jj,79)  = ftot_pn(ji,jj) 
    350                !! integrated diatom phytoplankton 
    351                trc2d(ji,jj,80)  = ftot_pd(ji,jj) 
    352                !! Integrated microzooplankton 
    353                trc2d(ji,jj,217) = ftot_zmi(ji,jj) 
    354                !! Integrated mesozooplankton 
    355                trc2d(ji,jj,218) = ftot_zme(ji,jj) 
    356                !! Integrated slow detritus, nitrogen 
    357                trc2d(ji,jj,219) = ftot_det(ji,jj) 
    358                !! Integrated slow detritus, carbon 
    359                trc2d(ji,jj,220) = ftot_dtc(ji,jj) 
    360 # if defined key_roam 
    361                !! The balance of nitrogen production/consumption. 
    362                !! integrated nitrogen production 
    363                trc2d(ji,jj,111) = fnit_prod(ji,jj) 
    364                !! integrated nitrogen consumption 
    365                trc2d(ji,jj,112) = fnit_cons(ji,jj) 
    366                !! The balance of carbon production/consumption. 
    367                !! integrated carbon production 
    368                trc2d(ji,jj,113) = fcar_prod(ji,jj) 
    369                !! integrated carbon consumption 
    370                trc2d(ji,jj,114) = fcar_cons(ji,jj) 
    371                !! The balance of oxygen production/consumption. 
    372                !! integrated oxygen production 
    373                trc2d(ji,jj,115) = foxy_prod(ji,jj) 
    374                !! integrated oxygen consumption 
    375                trc2d(ji,jj,116) = foxy_cons(ji,jj) 
    376                !! integrated unrealised oxygen consumption 
    377                trc2d(ji,jj,117) = foxy_anox(ji,jj) 
    378 # endif 
    379             ENDDO 
    380          ENDDO 
    381           
    382 # if defined key_roam 
    383 #  if defined key_axy_nancheck 
    384          !!--------------------------------------------------------------- 
    385          !! Check for NaNs in diagnostic outputs 
    386          !!--------------------------------------------------------------- 
    387          !!  
    388          !! 2D diagnostics 
    389          DO jn = 1,150 
    390             fq0 = SUM(trc2d(:,:,jn)) 
    391             !! AXY (30/01/14): "isnan" problem on HECTOR 
    392             !! if (fq0 /= fq0 ) then 
    393             if ( ieee_is_nan( fq0 ) ) then 
    394                !! there's a NaN here 
    395                if (lwp) write(numout,*)                                     & 
    396                   'NAN detected in 2D diagnostic field', jn, 'at time',     & 
    397                    kt, 'at position:' 
    398                DO jj = 1,jpj 
    399                   DO ji = 1,jpi 
    400                      if ( ieee_is_nan( trc2d(ji,jj,jn) ) ) then 
    401                         if (lwp) write (numout,'(a,3i6)') 'NAN-CHECK',      & 
    402                                  ji, jj, jn 
    403                      endif 
    404                   ENDDO 
    405                ENDDO 
    406           CALL ctl_stop( 'trcbio_medusa, NAN in 2D diagnostic field' ) 
    407             endif 
    408          ENDDO 
    409          !! 
    410          !! 3D diagnostics 
    411          DO jn = 1,5 
    412             fq0 = SUM(trc3d(:,:,:,jn)) 
    413             !! AXY (30/01/14): "isnan" problem on HECTOR 
    414             !! if (fq0 /= fq0 ) then 
    415             if ( ieee_is_nan( fq0 ) ) then 
    416                !! there's a NaN here 
    417                if (lwp) write(numout,*)                                     & 
    418                   'NAN detected in 3D diagnostic field', jn, 'at time',     & 
    419                   kt, 'at position:' 
    420                DO jk = 1,jpk 
    421                   DO jj = 1,jpj 
    422                      DO ji = 1,jpi 
    423                         if ( ieee_is_nan( trc3d(ji,jj,jk,jn) ) ) then 
    424                            if (lwp) write (numout,'(a,4i6)') 'NAN-CHECK',   & 
    425                                     ji, jj, jk, jn 
    426                         endif 
    427                      ENDDO 
    428                   ENDDO 
    429                ENDDO 
    430           CALL ctl_stop( 'trcbio_medusa, NAN in 3D diagnostic field' ) 
    431             endif 
    432          ENDDO 
    433     CALL flush(numout) 
    434 #  endif 
    435 # endif 
    436  
    437          !!---------------------------------------------------------------- 
    438          !! Don't know what this does; belongs to someone else ... 
    439          !!---------------------------------------------------------------- 
    440          !!  
    441          !! Lateral boundary conditions on trc2d 
    442          DO jn=1,jp_medusa_2d 
    443              CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 
    444          ENDDO  
    445  
    446          !! Lateral boundary conditions on trc3d 
    447          DO jn=1,jp_medusa_3d 
    448              CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 
    449          ENDDO  
    450  
    451  
    452 # if defined key_axy_nodiag 
    453          !!---------------------------------------------------------------- 
    454          !! Blank diagnostics as a NaN-trap 
    455          !!---------------------------------------------------------------- 
    456          !!  
    457          !! blank 2D diagnostic array 
    458          trc2d(:,:,:) = 0.e0 
    459          !! 
    460          !! blank 3D diagnostic array 
    461          trc3d(:,:,:,:) = 0.e0 
    462 # endif 
    463  
    464  
    465          !!---------------------------------------------------------------- 
    466          !! Add in XML diagnostics stuff 
    467          !!---------------------------------------------------------------- 
    468          !! 
    469          !! ** 2D diagnostics 
    470          DO jn=1,jp_medusa_2d 
    471             CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 
    472          END DO 
    473 !! AXY (17/02/14): don't think I need this if I modify the above for  
    474 !! all diagnostics 
    475 !! #  if defined key_roam 
    476 !!          DO jn=91,jp_medusa_2d 
    477 !!             CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 
    478 !!          END DO       
    479 !! #  endif 
    480          !! 
    481          !! ** 3D diagnostics 
    482          DO jn=1,jp_medusa_3d 
    483             CALL iom_put(TRIM(ctrc3d(jn)), trc3d(:,:,:,jn)) 
    484          END DO 
    485 !! AXY (17/02/14): don't think I need this if I modify the above for  
    486 !! all diagnostics 
    487 !! #  if defined key_roam 
    488 !!          CALL iom_put(TRIM(ctrc3d(5)), trc3d(:,:,:,5)) 
    489 !! #  endif 
    490  
    491  
    492       ELSE IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 
     302 
    493303         !!!--------------------------------------------------------------- 
    494304         !! Add very last diag calculations  
    … …  
    529339         !! ** 2D diagnostics 
    530340#   if defined key_debug_medusa 
    531          IF (lwp) write (numout,*) 'trc_bio_medusa: export all diag.' 
     341         IF (lwp) write (numout,*) 'bio_medusa_fin: export all diag kt = ', kt 
    532342         CALL flush(numout) 
    533343#   endif 
    … …  
    1181991          DEALLOCATE( zw2d ) 
    1182992 
    1183        ENDIF                    ! end of ln_diatrc option 
    1184  
    1185993   END SUBROUTINE bio_medusa_fin 
    1186994 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90

    r8441 r8442  
    3535      USE par_oce,           ONLY: jpi, jpj, jpk 
    3636      USE sms_medusa,        ONLY: jdms 
    37       USE trc,               ONLY: ln_diatrc, med_diag, nittrc000,     & 
    38                                    trc2d, trc3d 
     37      USE trc,               ONLY: ln_diatrc, med_diag, nittrc000  
     38      USE in_out_manager,    ONLY: lwp 
    3939 
    4040# if defined key_iomput 
    … …  
    4747 
    4848      IF( ln_diatrc ) THEN 
    49          !! blank 2D diagnostic array 
    50          trc2d(:,:,:) = 0.e0 
    51          !! 
    52          !! blank 3D diagnostic array 
    53          trc3d(:,:,:,:) = 0.e0 
     49         IF (lwp) write (numout,*) 'Diagnostics are now ALL through XIOS (key_xios)' 
     50         IF (lwp) write (numout,*) 'No more key_diatrc anymore.' 
    5451      ENDIF 
    5552 
    … …  
    171168      !! ----------------------------- 
    172169      !! Juju :: add kt condition !! 
    173       IF ( lk_iomput .AND. .NOT.  ln_diatrc ) THEN  
     170      IF ( lk_iomput ) THEN  
    174171 
    175172         !! initialise iom_use test 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90

    r8441 r8442  
    161161 
    162162   !! Add DMS in MEDUSA for UKESM1 model 
    163    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_surf 
     163   REAL(wp)                              :: dms_surf,dms_andm 
    164164   !! AXY (13/03/15): add in other DMS calculations 
    165    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_andr,dms_simo,dms_aran,dms_hall 
    166    REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_andm, dms_nlim, dms_wtkn 
     165   REAL(wp)                              :: dms_andr,dms_simo,dms_aran,dms_hall 
     166   REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: dms_nlim, dms_wtkn 
    167167# endif 
    168168 
    … …  
    360360               foxy_prod(jpi,jpj), foxy_cons(jpi,jpj),                & 
    361361               foxy_anox(jpi,jpj),                                    & 
    362                dms_surf(jpi,jpj),                                     & 
    363                dms_andr(jpi,jpj),dms_simo(jpi,jpj),                   & 
    364                dms_aran(jpi,jpj),dms_hall(jpi,jpj),dms_andm(jpi,jpj), & 
    365362               dms_nlim(jpi,jpj),dms_wtkn(jpi,jpj),                   & 
    366363# endif 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_update.F90

    r8441 r8442  
    781781#   if defined key_debug_medusa 
    782782      IF (lwp) write (numout,*) '------' 
    783       IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations' 
    784       IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs' 
     783      IF (lwp) write (numout,*) 'bio_medusa_update: end all calculations' 
     784      IF (lwp) write (numout,*) 'bio_medusa_update: now outputs kt = ', kt 
    785785      CALL flush(numout) 
    786786#   endif 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r8441 r8442  
    9999      USE sbc_oce,                    ONLY: lk_oasis 
    100100      USE sms_medusa,                 ONLY: hist_pco2 
    101       USE trc,                        ONLY: ln_diatrc, ln_rsttr,            & 
    102                                             nittrc000, trn 
    103   
     101      USE trc,                        ONLY: ln_rsttr, nittrc000, trn 
    104102      USE bio_medusa_init_mod,        ONLY: bio_medusa_init 
    105103      USE carb_chem_mod,              ONLY: carb_chem 
    … …  
    640638         !! 2d specific k level diags 
    641639         !!------------------------------------------------------- 
    642          IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
     640         IF( lk_iomput ) THEN 
    643641            CALL bio_medusa_diag_slice( jk ) 
    644642         ENDIF 
    … …  
    651649      !!------------------------------------------------------------------ 
    652650      CALL bio_medusa_fin( kt ) 
    653  
    654 # if defined key_trc_diabio 
    655        !! Lateral boundary conditions on trcbio 
    656        DO jn=1,jp_medusa_trd 
    657           CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 
    658        ENDDO  
    659 # endif 
    660651 
    661652# if defined key_debug_medusa 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90

    r8131 r8442  
    9393      INTEGER :: jl, jn 
    9494      INTEGER :: ios                 ! Local integer output status for namelist read 
    95       TYPE(DIAG), DIMENSION(jp_medusa_2d)  :: meddia2d 
    96       TYPE(DIAG), DIMENSION(jp_medusa_3d)  :: meddia3d 
    97       TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio 
    9895      CHARACTER(LEN=32)   ::   clname 
    9996      !! 
    100       NAMELIST/nammeddia/ meddia3d, meddia2d     ! additional diagnostics 
    101  
    10297      !!---------------------------------------------------------------------- 
    10398 
    … …  
    126121# if defined key_debug_medusa 
    127122      CALL flush(numout) 
    128 # endif 
    129       ! 
    130 # if defined key_debug_medusa 
    131       IF (lwp) write (numout,*) '------------------------------' 
    132       IF (lwp) write (numout,*) 'Jpalm - debug' 
    133       IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia' 
    134       IF (lwp) write (numout,*) ' ' 
    135       CALL flush(numout) 
    136 # endif 
    137  
    138      IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 
    139          ! 
    140          ! Namelist nammeddia 
    141          ! ------------------- 
    142          REWIND( numnatp_ref )              ! Namelist nammeddia in reference namelist : MEDUSA diagnostics 
    143          READ  ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901) 
    144 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp ) 
    145  
    146          REWIND( numnatp_cfg )              ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics 
    147          READ  ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 ) 
    148 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp ) 
    149          IF(lwm) WRITE ( numonp, nammeddia ) 
    150  
    151 # if defined key_debug_medusa 
    152          IF (lwp) write (numout,*) '------------------------------' 
    153          IF (lwp) write (numout,*) 'Jpalm - debug' 
    154          IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK' 
    155          IF (lwp) write (numout,*) 'Check number of variable in nammeddia:' 
    156          IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d 
    157          IF (lwp) write (numout,*) ' ' 
    158          CALL flush(numout) 
    159 # endif 
    160          DO jl = 1, jp_medusa_2d 
    161             jn = jp_msa0_2d + jl - 1 
    162 # if defined key_debug_medusa 
    163             IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 2D' 
    164             IF (lwp) write (numout,*) jl,'meddia2d-sname: ',meddia2d(jl)%sname  
    165             IF (lwp) write (numout,*) jl,'meddia2d-lname: ',meddia2d(jl)%lname  
    166             IF (lwp) write (numout,*) jl,'meddia2d-units: ',meddia2d(jl)%units  
    167             CALL flush(numout) 
    168 # endif 
    169             ctrc2d(jn) = meddia2d(jl)%sname 
    170             ctrc2l(jn) = meddia2d(jl)%lname 
    171             ctrc2u(jn) = meddia2d(jl)%units 
    172          END DO 
    173  
    174          DO jl = 1, jp_medusa_3d 
    175             jn = jp_msa0_3d + jl - 1 
    176 # if defined key_debug_medusa 
    177             IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 3D' 
    178             IF (lwp) write (numout,*) jl,'meddia3d-sname: ',meddia3d(jl)%sname  
    179             IF (lwp) write (numout,*) jl,'meddia3d-lname: ',meddia3d(jl)%lname 
    180             IF (lwp) write (numout,*) jl,'meddia3d-units: ',meddia3d(jl)%units 
    181             CALL flush(numout) 
    182 # endif 
    183             ctrc3d(jn) = meddia3d(jl)%sname 
    184             ctrc3l(jn) = meddia3d(jl)%lname 
    185             ctrc3u(jn) = meddia3d(jl)%units 
    186          END DO 
    187  
    188          IF(lwp) THEN                   ! control print 
    189 # if defined key_debug_medusa 
    190             IF (lwp) write (numout,*) '------------------------------' 
    191             IF (lwp) write (numout,*) 'Jpalm - debug' 
    192             IF (lwp) write (numout,*) 'Var name assignation OK' 
    193             IF (lwp) write (numout,*) 'next check var names' 
    194             IF (lwp) write (numout,*) ' ' 
    195             CALL flush(numout) 
    196 # endif 
    197             WRITE(numout,*) 
    198             WRITE(numout,*) ' Namelist : natadd' 
    199             DO jl = 1, jp_medusa_3d 
    200                jn = jp_msa0_3d + jl - 1 
    201                WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
    202                  &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
    203             END DO 
    204             WRITE(numout,*) ' ' 
    205  
    206             DO jl = 1, jp_medusa_2d 
    207                jn = jp_msa0_2d + jl - 1 
    208                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    209                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    210             END DO 
    211             WRITE(numout,*) ' ' 
    212          ENDIF 
    213          ! 
    214       ENDIF    
    215          ! 
    216 # if defined key_debug_medusa 
    217             CALL flush(numout) 
    218123# endif 
    219124 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r8074 r8442  
    4545 
    4646   !! * Module variables 
    47    INTEGER ::                   & 
    48      ryyss,                     &  !: number of seconds per year 
    49      rmtss                         !: number of seconds per month 
     47   !! INTEGER ::                   & 
     48     !! ryyss,                     &  !: number of seconds per year 
     49     !! rmtss                         !: number of seconds per month 
    5050 
    5151   !! AXY (10/02/09) 
    … …  
    123123 
    124124      ! Number of seconds per year and per month 
    125       ryyss = nyear_len(1) * rday 
    126       rmtss = ryyss / raamo 
     125      !! ryyss = nyear_len(1) * rday 
     126      !! rmtss = ryyss / raamo 
    127127 
    128128      !! AXY (20/11/14): alter this to report on first MEDUSA call 
    … …  
    173173               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    174174               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
    175 # if defined key_trc_diabio 
    176                trbio(ji,jj,jk,8) = ztra 
    177 # endif 
    178                IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
    179                      IF( med_diag%DSED%dgsave ) THEN 
    180                          zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
    181                       ENDIF    
    182                ELSE IF( ln_diatrc )  THEN 
    183                     trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
    184                ENDIF     
     175               IF( med_diag%DSED%dgsave ) THEN 
     176                   zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
     177               ENDIF    
    185178                 
    186179            END DO 
    … …  
    188181      END DO 
    189182      ! 
    190 # if defined key_trc_diabio 
    191       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio 
    192 # endif 
    193       IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    194       !! 
    195       IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 
    196            IF( med_diag%DSED%dgsave ) THEN 
    197                 CALL iom_put( "DSED"  ,  zw2d) 
    198                 CALL wrk_dealloc( jpi, jpj,    zw2d  ) 
    199             ENDIF 
    200       ELSE IF (lk_iomput .AND. ln_diatrc)  THEN     
    201           CALL iom_put( "DSED",trc2d(:,:,8) ) 
     183      IF( med_diag%DSED%dgsave ) THEN 
     184           CALL iom_put( "DSED"  ,  zw2d) 
     185           CALL wrk_dealloc( jpi, jpj,    zw2d  ) 
    202186      ENDIF 
    203187      !! 
    … …  
    229213               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    230214               tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra 
    231 !! #  if defined key_trc_diabio 
    232 !!                trbio(ji,jj,jk,8) = ztra 
    233 !! #  endif 
    234 !!             IF( ln_diatrc ) & 
    235 !!                &  trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 
    236215            END DO 
    237216         END DO 
    238217      END DO 
    239218      ! 
    240 !! #  if defined key_trc_diabio 
    241 !!       CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. )                    ! Lateral boundary conditions on trcbio 
    242 !! #  endif 
    243 !!       IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    244 !! #  if defined key_iomput 
    245 !!       CALL iom_put( "DSED",trc2d(:,:,8) ) 
    246 !! #  endif 
    247219 
    248220# endif 
Note: See TracChangeset for help on using the changeset viewer.