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 – NEMO

Changeset 8442


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
Files:
2 deleted
24 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90

    r6715 r8442  
    5757      IF( nn_timing == 1 )  CALL timing_start('trc_sms_age') 
    5858      ! 
    59       IF(lwp) WRITE(numout,*) 
    60       IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model' 
    61       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     59      IF( kt == nittrc000 ) THEN 
     60         IF(lwp) WRITE(numout,*) 
     61         IF(lwp) WRITE(numout,*) ' trc_sms_age:  AGE model' 
     62         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     63      ENDIF 
    6264 
    6365      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrage ) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r6486 r8442  
    4949      ! definition of additional diagnostic as a structure 
    5050      INTEGER :: jl, jn 
    51       TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d 
    52       TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d 
    5351      !! 
    5452      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    55       NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics 
    5653      !!------------------------------------------------------------------- 
    5754      !                             ! Open namelist file 
    … …  
    7774      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    7875      ! 
    79       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    80          ! 
    81          ! Namelist namc14dia 
    82          ! ------------------- 
    83          REWIND( numnatb_ref )              ! Namelist namc14dia in reference namelist : c14b diagnostics 
    84          READ  ( numnatb_ref, namc14dia, IOSTAT = ios, ERR = 903) 
    85 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in reference namelist', lwp ) 
    86  
    87          REWIND( numnatb_cfg )              ! Namelist namc14dia in configuration namelist : c14b diagnostics 
    88          READ  ( numnatb_cfg, namc14dia, IOSTAT = ios, ERR = 904 ) 
    89 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in configuration namelist', lwp ) 
    90          IF(lwm) WRITE ( numonb, namc14dia ) 
    91  
    92          DO jl = 1, jp_c14b_2d 
    93             jn = jp_c14b0_2d + jl - 1 
    94             ctrc2d(jn) = c14dia2d(jl)%sname 
    95             ctrc2l(jn) = c14dia2d(jl)%lname 
    96             ctrc2u(jn) = c14dia2d(jl)%units 
    97          END DO 
    98  
    99          DO jl = 1, jp_c14b_3d 
    100             jn = jp_c14b0_3d + jl - 1 
    101             ctrc3d(jn) = c14dia3d(jl)%sname 
    102             ctrc3l(jn) = c14dia3d(jl)%lname 
    103             ctrc3u(jn) = c14dia3d(jl)%units 
    104          END DO 
    105  
    106          IF(lwp) THEN                   ! control print 
    107             WRITE(numout,*) 
    108             WRITE(numout,*) ' Namelist : natadd' 
    109             DO jl = 1, jp_c14b_3d 
    110                jn = jp_c14b0_3d + jl - 1 
    111                WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
    112                  &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
    113             END DO 
    114             WRITE(numout,*) ' ' 
    115  
    116             DO jl = 1, jp_c14b_2d 
    117                jn = jp_c14b0_2d + jl - 1 
    118                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    119                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    120             END DO 
    121             WRITE(numout,*) ' ' 
    122          ENDIF 
    123          ! 
    124       ENDIF 
    12576 
    12677   IF(lwm) CALL FLUSH ( numonb )     ! flush output namelist C14b 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r8280 r8442  
    4747      INTEGER :: ios                 ! Local integer output status for namelist read 
    4848      INTEGER :: jl, jn 
    49       TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5049      !! 
    5150      NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type  
    52       NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
    5351      !!---------------------------------------------------------------------- 
    5452      !                             ! Open namelist files 
    … …  
    8280      ! 
    8381 
    84       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    85          ! 
    86          ! Namelist namcfcdia 
    87          ! ------------------- 
    88          REWIND( numnatc_ref )              ! Namelist namcfcdia in reference namelist : CFC diagnostics 
    89          READ  ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903) 
    90 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp ) 
    91  
    92          REWIND( numnatc_cfg )              ! Namelist namcfcdia in configuration namelist : CFC diagnostics 
    93          READ  ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 ) 
    94 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp ) 
    95          IF(lwm) WRITE ( numonc, namcfcdia ) 
    96  
    97          DO jl = 1, jp_cfc_2d 
    98             jn = jp_cfc0_2d + jl - 1 
    99             ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 
    100             ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 
    101             ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 
    102          END DO 
    103  
    104          IF(lwp) THEN                   ! control print 
    105             WRITE(numout,*) 
    106             WRITE(numout,*) ' Namelist : natadd' 
    107             DO jl = 1, jp_cfc_2d 
    108                jn = jp_cfc0_2d + jl - 1 
    109                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    110                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    111             END DO 
    112             WRITE(numout,*) ' ' 
    113          ENDIF 
    114          ! 
    115       ENDIF 
    116  
    11782   IF(lwm) CALL FLUSH ( numonc )     ! flush output namelist CFC 
    11883 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r8280 r8442  
    257257      !ENDIF                                             
    258258      ! 
    259       IF( lk_iomput ) THEN 
    260          IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    261          IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    262          IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
    263          IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
    264          IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
    265          IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    266       ELSE 
    267          IF( ln_diatrc ) THEN 
    268             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    269             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    270             trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 
    271             trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 
    272             trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 
    273             trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 
    274          END IF 
    275       END IF 
     259      IF  (iom_use("qtrCFC11"))  CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     260      IF  (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     261      IF  (iom_use("qtrCFC12"))  CALL iom_put( "qtrCFC12"  , qtr_cfc (:,:,2) ) 
     262      IF  (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 
     263      IF  (iom_use("qtrSF6"))    CALL iom_put( "qtrSF6"    , qtr_cfc (:,:,3) ) 
     264      IF  (iom_use("qintSF6"))   CALL iom_put( "qintSF6"   , qint_cfc(:,:,3) ) 
    276265      ! 
    277266      IF( l_trdtrc ) THEN 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

    r6829 r8442  
    165165      !ENDIF 
    166166      ! 
    167       IF( lk_iomput ) THEN 
    168167         CALL iom_put( "qtrIDTRA"  , qtr_idtra (:,:,1) ) 
    169168         CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) 
    170169         CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) 
    171       ELSE 
    172          IF( ln_diatrc ) THEN 
    173             trc2d(:,:,jp_idtra0_2d    ) = qtr_idtra (:,:,1) 
    174             trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1) 
    175             trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1) 
    176          END IF 
    177       END IF 
    178170      ! 
    179171# if defined key_debug_medusa 

  • 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 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r8280 r8442  
    2929   USE trdtra 
    3030   USE prtctl_trc      ! Print control 
    31    !! USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3231 
    3332   IMPLICIT NONE 
    … …  
    109108      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    110109      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    111       !  
    112       !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...  
    113       !! DO jn = 1, jptra 
    114       !!   CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    115       !!   CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
    116       !! END DO 
    117       ! 
    118110 
    119111      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r8356 r8442  
    7777         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    7878                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    79 # if defined key_debug_medusa 
    80          IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 
    81          CALL trc_rst_tra_stat 
    82          CALL flush(numout) 
    83 # endif 
    84  
    8579         IF( ln_zps ) THEN 
    8680           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kstp, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
    … …  
    9589#endif 
    9690                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    97 # if defined key_debug_medusa 
    98          IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 
    99          CALL trc_rst_tra_stat 
    100          CALL flush(numout) 
    101 # endif 
    10291                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
    10392# if defined key_debug_medusa 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r8280 r8442  
    1515   USE par_c14b      ! C14 bomb tracer 
    1616   USE par_cfc       ! CFC 11 and 12 tracers 
     17   USE par_age       ! AGE  tracer 
    1718   USE par_my_trc    ! user defined passive tracers 
     19   USE par_idtra     ! Idealize tracer 
    1820   USE par_medusa    ! MEDUSA model 
    19    USE par_idtra     ! Idealize tracer 
    20    USE par_age       ! AGE  tracer 
    2121 
    2222   IMPLICIT NONE 
    … …  
    2828   ! Passive tracers : Total size 
    2929   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc    + jp_medusa    + jp_idtra     + jp_age 
    31    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d  + jp_age_2d 
    32    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d  + jp_age_3d 
     30   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_age    + jp_my_trc    + jp_idtra     + jp_medusa    
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_age_2d + jp_my_trc_2d + jp_idtra_2d  + jp_medusa_2d 
     32   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_age_3d + jp_my_trc_3d + jp_idtra_3d  + jp_medusa_3d 
    3333   !                     ! total number of sms diagnostic arrays 
    34    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 
     34   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd + jp_idtra_trd + jp_medusa_trd  
    3535    
    3636   !  1D configuration ("key_c1d") 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r8441 r8442  
    2424   USE trcini_pisces   ! PISCES   initialisation 
    2525   USE trcini_c14b     ! C14 bomb initialisation 
     26   USE trcini_age      ! AGE      initialisation 
    2627   USE trcini_my_trc   ! MY_TRC   initialisation 
     28   USE trcini_idtra    ! idealize tracer initialisation 
    2729   USE trcini_medusa   ! MEDUSA   initialisation 
    28    USE trcini_idtra    ! idealize tracer initialisation 
    29    USE trcini_age      ! AGE      initialisation 
    3030   USE trcdta          ! initialisation from files 
    3131   USE daymod          ! calendar manager 
    … …  
    7979         &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    8080         & Computation of a daily mean shortwave for some biogeochemical models) ') 
    81           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    82           !!!!! CHECK For MEDUSA 
    83           !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     81 
    8482      IF( nn_cla == 1 )   & 
    8583         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    … …  
    102100 
    103101      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    104       IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
    105       IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
    106102      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    107103      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    108104      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
    109105      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     106      IF( lk_idtra   )       CALL trc_ini_idtra        ! Idealize tracers 
     107      IF( lk_medusa  )       CALL trc_ini_medusa       ! MEDUSA  tracers 
    110108 
    111109      CALL trc_ice_ini                                 ! Tracers in sea ice 
    112  
    113 # if defined key_debug_medusa 
    114          IF (lwp) write (numout,*) '------------------------------' 
    115          IF (lwp) write (numout,*) 'Jpalm - debug' 
    116          IF (lwp) write (numout,*) ' in trc_init' 
    117          IF (lwp) write (numout,*) ' sms init OK' 
    118          IF (lwp) write (numout,*) ' next: open tracer.stat' 
    119          IF (lwp) write (numout,*) ' ' 
    120          CALL flush(numout) 
    121 # endif 
    122110 
    123111      IF( ln_ctl ) THEN 
    … …  
    133121      ENDIF 
    134122 
    135 # if defined key_debug_medusa 
    136          IF (lwp) write (numout,*) '------------------------------' 
    137          IF (lwp) write (numout,*) 'Jpalm - debug' 
    138          IF (lwp) write (numout,*) ' in trc_init' 
    139          IF (lwp) write (numout,*) 'open tracer.stat -- OK' 
    140          IF (lwp) write (numout,*) ' ' 
    141          CALL flush(numout) 
    142 # endif 
    143  
    144  
    145123      IF( ln_trcdta ) THEN 
    146 #if defined key_medusa 
    147          IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 
    148          IF(lwp) CALL flush(numout) 
    149 #endif 
    150124         CALL trc_dta_init(jptra) 
    151125      ENDIF 
    … …  
    153127      IF( ln_rsttr ) THEN 
    154128        ! 
    155 #if defined key_medusa 
    156         IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 
    157         IF(lwp) CALL flush(numout) 
    158 #endif 
    159129        CALL trc_rst_read              ! restart from a file 
    160130        ! 
    161131      ELSE 
    162         ! 
    163 # if defined key_debug_medusa 
    164          IF (lwp) write (numout,*) '------------------------------' 
    165          IF (lwp) write (numout,*) 'Jpalm - debug' 
    166          IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 
    167          IF (lwp) write (numout,*) ' ' 
    168          CALL flush(numout) 
    169 # endif 
    170132        ! 
    171133        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    … …  
    188150        ENDIF 
    189151        ! 
    190 # if defined key_debug_medusa 
    191          IF (lwp) write (numout,*) '------------------------------' 
    192          IF (lwp) write (numout,*) 'Jpalm - debug' 
    193          IF (lwp) write (numout,*) ' in trc_init' 
    194          IF (lwp) write (numout,*) ' before trb = trn' 
    195          IF (lwp) write (numout,*) ' ' 
    196          CALL flush(numout) 
    197 # endif 
    198         ! 
    199152        trb(:,:,:,:) = trn(:,:,:,:) 
    200153        !  
    201 # if defined key_debug_medusa 
    202          IF (lwp) write (numout,*) '------------------------------' 
    203          IF (lwp) write (numout,*) 'Jpalm - debug' 
    204          IF (lwp) write (numout,*) ' in trc_init' 
    205          IF (lwp) write (numout,*) ' trb = trn -- OK' 
    206          IF (lwp) write (numout,*) ' ' 
    207          CALL flush(numout) 
    208 # endif 
    209         !  
    210154      ENDIF 
    211155  
    212156      tra(:,:,:,:) = 0._wp 
    213157      ! 
    214 # if defined key_debug_medusa 
    215          IF (lwp) write (numout,*) '------------------------------' 
    216          IF (lwp) write (numout,*) 'Jpalm - debug' 
    217          IF (lwp) write (numout,*) ' in trc_init' 
    218          IF (lwp) write (numout,*) ' partial step -- OK' 
    219          IF (lwp) write (numout,*) ' ' 
    220          CALL flush(numout) 
    221 # endif 
    222       ! 
    223158      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    224159      ! 
    225 # if defined key_debug_medusa 
    226          IF (lwp) write (numout,*) '------------------------------' 
    227          IF (lwp) write (numout,*) 'Jpalm - debug' 
    228          IF (lwp) write (numout,*) ' in trc_init' 
    229          IF (lwp) write (numout,*) ' before initiate tracer contents' 
    230          IF (lwp) write (numout,*) ' ' 
    231          CALL flush(numout) 
    232 # endif 
    233       ! 
     160 
    234161      trai(:) = 0._wp                                                   ! initial content of all tracers 
    235162      DO jn = 1, jptra 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r8280 r8442  
    2525   USE trcnam_cfc        ! CFC SMS namelist 
    2626   USE trcnam_c14b       ! C14 SMS namelist 
     27   USE trcnam_age        ! AGE SMS namelist 
    2728   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     29   USE trcnam_idtra      ! Idealise tracer namelist 
    2830   USE trcnam_medusa     ! MEDUSA namelist 
    29    USE trcnam_idtra      ! Idealise tracer namelist 
    30    USE trcnam_age        ! AGE SMS namelist 
    3131   USE trd_oce        
    3232   USE trdtrc_oce 
    … …  
    6565       
    6666      !                                        !  passive tracer informations 
    67 # if defined key_debug_medusa 
    68       CALL flush(numout) 
    69       IF (lwp) write (numout,*) '------------------------------' 
    70       IF (lwp) write (numout,*) 'Jpalm - debug' 
    71       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 
    72       IF (lwp) write (numout,*) ' ' 
    73 # endif 
    74       ! 
    7567      CALL trc_nam_trc 
    7668       
    7769      !                                        !   Parameters of additional diagnostics 
    78 # if defined key_debug_medusa 
    79       CALL flush(numout) 
    80       IF (lwp) write (numout,*) '------------------------------' 
    81       IF (lwp) write (numout,*) 'Jpalm - debug' 
    82       IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 
    83       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 
    84       IF (lwp) write (numout,*) ' ' 
    85 # endif 
    86       ! 
    87  
    8870      CALL trc_nam_dia 
    8971 
    9072      !                                        !   namelist of transport 
    91 # if defined key_debug_medusa 
    92       CALL flush(numout) 
    93       IF (lwp) write (numout,*) '------------------------------' 
    94       IF (lwp) write (numout,*) 'Jpalm - debug' 
    95       IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 
    96       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 
    97       IF (lwp) write (numout,*) ' ' 
    98 # endif 
    99       ! 
    10073      CALL trc_nam_trp 
    101       ! 
    102 # if defined key_debug_medusa 
    103       CALL flush(numout) 
    104       IF (lwp) write (numout,*) '------------------------------' 
    105       IF (lwp) write (numout,*) 'Jpalm - debug' 
    106       IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 
    107       IF (lwp) write (numout,*) 'continue trc_nam ' 
    108       IF (lwp) write (numout,*) ' ' 
    109       CALL flush(numout) 
    110 # endif 
    111       ! 
    11274 
    11375 
    … …  
    13193         END DO 
    13294         WRITE(numout,*) ' ' 
    133 # if defined key_debug_medusa 
    134       CALL flush(numout) 
    135 # endif 
    13695      ENDIF 
    13796 
    … …  
    152111            WRITE(numout,*) 
    153112         ENDIF 
    154 # if defined key_debug_medusa 
    155       CALL flush(numout) 
    156 # endif 
    157113      ENDIF 
    158114 
    … …  
    170126        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    171127        WRITE(numout,*)  
    172 # if defined key_debug_medusa 
    173       CALL flush(numout) 
    174 # endif 
    175128      ENDIF 
    176129 
    … …  
    200153               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    201154            END DO 
    202          WRITE(numout,*) ' ' 
    203          CALL flush(numout) 
    204155         ENDIF 
    205156#endif 
    206157 
    207 # if defined key_debug_medusa 
    208       CALL flush(numout) 
    209       IF (lwp) write (numout,*) '------------------------------' 
    210       IF (lwp) write (numout,*) 'Jpalm - debug' 
    211       IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 
    212       IF (lwp) write (numout,*) ' ' 
    213 # endif 
    214       ! 
    215158 
    216159      ! Call the ice module for tracers 
    217160      ! ------------------------------- 
    218161      CALL trc_nam_ice 
    219  
    220 # if defined key_debug_medusa 
    221       CALL flush(numout) 
    222       IF (lwp) write (numout,*) '------------------------------' 
    223       IF (lwp) write (numout,*) 'Jpalm - debug' 
    224       IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 
    225       IF (lwp) write (numout,*) ' ' 
    226 # endif 
    227       ! 
    228162 
    229163      ! namelist of SMS 
    … …  
    232166      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    233167      ENDIF 
    234       ! 
    235 # if defined key_debug_medusa 
    236       CALL flush(numout) 
    237       IF (lwp) write (numout,*) '------------------------------' 
    238       IF (lwp) write (numout,*) 'Jpalm - debug' 
    239       IF (lwp) write (numout,*) 'CALL trc_nam_pisces  -- OK' 
    240       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 
    241       IF (lwp) write (numout,*) ' ' 
    242 # endif 
    243       ! 
     168 
     169      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
     170      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
     171      ENDIF 
     172 
     173      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
     174      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     175      ENDIF 
     176 
     177      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     178      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     179      ENDIF 
     180 
     181      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
     182      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
     183      ENDIF 
     184 
     185      IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
     186      ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
     187      ENDIF 
     188 
    244189      IF( lk_medusa  ) THEN   ;   CALL trc_nam_medusa      ! MEDUSA  tracers 
    245190      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MEDUSA not used' 
    246191      ENDIF 
    247192      ! 
    248 # if defined key_debug_medusa 
    249       CALL flush(numout) 
    250       IF (lwp) write (numout,*) '------------------------------' 
    251       IF (lwp) write (numout,*) 'Jpalm - debug' 
    252       IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 
    253       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 
    254       IF (lwp) write (numout,*) ' ' 
    255 # endif 
    256       ! 
    257       IF( lk_idtra   ) THEN   ;   CALL trc_nam_idtra       ! Idealize tracers 
    258       ELSE                    ;   IF(lwp) WRITE(numout,*) '          Idealize tracers not used' 
    259       ENDIF 
    260       ! 
    261 # if defined key_debug_medusa 
    262       CALL flush(numout) 
    263       IF (lwp) write (numout,*) '------------------------------' 
    264       IF (lwp) write (numout,*) 'Jpalm - debug' 
    265       IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 
    266       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 
    267       IF (lwp) write (numout,*) ' ' 
    268 # endif 
    269       ! 
    270       IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    271       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    272       ENDIF 
    273       ! 
    274 # if defined key_debug_medusa 
    275       CALL flush(numout) 
    276       IF (lwp) write (numout,*) '------------------------------' 
    277       IF (lwp) write (numout,*) 'Jpalm - debug' 
    278       IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 
    279       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 
    280       IF (lwp) write (numout,*) ' ' 
    281 # endif 
    282       ! 
    283       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    284       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    285       ENDIF 
    286       ! 
    287 # if defined key_debug_medusa 
    288       CALL flush(numout) 
    289       IF (lwp) write (numout,*) '------------------------------' 
    290       IF (lwp) write (numout,*) 'Jpalm - debug' 
    291       IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 
    292       IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 
    293       IF (lwp) write (numout,*) ' ' 
    294 # endif 
    295       ! 
    296       IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
    297       ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
    298       ENDIF 
    299       ! 
    300 # if defined key_debug_medusa 
    301       CALL flush(numout) 
    302       IF (lwp) write (numout,*) '------------------------------' 
    303       IF (lwp) write (numout,*) 'Jpalm - debug' 
    304       IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 
    305       IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 
    306       IF (lwp) write (numout,*) ' ' 
    307 # endif 
    308       ! 
    309       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    310       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    311       ENDIF 
    312         
    313       IF(lwp)   CALL flush(numout) 
    314193   END SUBROUTINE trc_nam 
    315194 
    … …  
    450329         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    451330      END DO 
    452       IF(lwp)  CALL flush(numout)       
    453  
     331       
    454332    END SUBROUTINE trc_nam_trc 
    455333 
    … …  
    504382         CALL flush(numout) 
    505383      ENDIF 
    506 !! 
    507 !! JPALM -- 17-07-2015 -- 
    508 !! MEDUSA is not yet up-to-date with the iom server. 
    509 !! we use it for the main tracer, but not fully with diagnostics. 
    510 !! will have to adapt it properly when visiting Christian Ethee 
    511 !! for now, we change  
    512 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
    513 !! to : 
    514 !! 
     384 
    515385      IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN  
    516386         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    … …  
    522392         trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    523393         ! 
    524       !! ELSE IF  ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 
    525       !!    CALL trc_nam_iom_medusa 
    526394      ENDIF 
    527395 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r8280 r8442  
    1616   USE trc                ! 
    1717   USE trcsms_pisces      ! PISCES biogeo-model 
    18    USE trcsms_medusa      ! MEDUSA tracers 
    19    USE trcsms_idtra       ! Idealize Tracer 
    2018   USE trcsms_cfc         ! CFC 11 & 12 
    2119   USE trcsms_c14b        ! C14b tracer  
    2220   USE trcsms_age         ! AGE tracer  
    2321   USE trcsms_my_trc      ! MY_TRC  tracers 
     22   USE trcsms_idtra       ! Idealize Tracer 
     23   USE trcsms_medusa      ! MEDUSA tracers 
    2424   USE prtctl_trc         ! Print control for debbuging 
    2525 
    … …  
    4646      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4747      !! 
    48       INTEGER            ::  jn 
    4948      CHARACTER (len=25) :: charout 
    5049      !!--------------------------------------------------------------------- 
    … …  
    5352      ! 
    5453      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     54      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     55      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     56      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
     57      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
     58      IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
    5559      IF( lk_medusa  )   CALL trc_sms_medusa ( kt )    ! MEDUSA  tracers 
    56 # if defined key_debug_medusa 
    57          IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK --  next IDTRA -- ' 
    58       CALL flush(numout) 
    59 # endif 
    60       IF( lk_idtra   )   CALL trc_sms_idtra  ( kt )    ! radioactive decay of Id. tracer 
    61 # if defined key_debug_medusa 
    62          IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK --  next CFC -- ' 
    63       CALL flush(numout) 
    64 # endif 
    65       IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    66 # if defined key_debug_medusa 
    67          IF(lwp) WRITE(numout,*) '--trcsms : CFC OK --  next C14 -- ' 
    68       CALL flush(numout) 
    69 # endif 
    70       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
    71 # if defined key_debug_medusa 
    72          IF(lwp) WRITE(numout,*) '--trcsms : C14 OK --  next C14 -- ' 
    73       CALL flush(numout) 
    74 # endif 
    75       IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
    76 # if defined key_debug_medusa 
    77          IF(lwp) WRITE(numout,*) '--trcsms : Age OK --  Continue  -- ' 
    78       CALL flush(numout) 
    79 # endif 
    80       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    8160 
    8261      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r8356 r8442  
    8989         tra(:,:,:,:) = 0.e0 
    9090         ! 
    91 # if defined key_debug_medusa 
    92          IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 
    93          CALL flush(numout) 
    94 # endif 
    9591                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    96 # if defined key_debug_medusa 
    97                                    CALL trc_rst_stat  
    98                                    CALL trc_rst_tra_stat 
    99 # endif 
    10092         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    10193         IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    … …  
    124116         ! 
    125117         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    126 # if defined key_debug_medusa 
    127          IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 
    128          CALL flush(numout) 
    129 # endif 
    130118         ! 
    131119      ENDIF 

  • branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r8280 r8442  
    2121   USE trcwri_cfc 
    2222   USE trcwri_c14b 
     23   USE trcwri_age 
    2324   USE trcwri_my_trc 
     25   USE trcwri_idtra 
    2426   USE trcwri_medusa 
    25    USE trcwri_idtra 
    26    USE trcwri_age 
    2727 
    2828   IMPLICIT NONE 
    … …  
    6161      ! --------------------------------------- 
    6262      IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
    63       IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
    64       IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
    6563      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6664      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
    6765      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6866      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     67      IF( lk_idtra   )   CALL trc_wri_idtra       ! Idealize tracers 
     68      IF( lk_medusa  )   CALL trc_wri_medusa     ! MESDUSA 
    6969      ! 
    7070      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.