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/bio_medusa_fin.F90 – 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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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 
Note: See TracChangeset for help on using the changeset viewer.