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 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90 – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r2715 r3294  
    5252      CHARACTER (len=22) :: charout 
    5353      !!---------------------------------------------------------------------- 
    54  
    55       IF( kt == nit000 ) THEN 
     54      ! 
     55      IF( nn_timing == 1 )  CALL timing_start('trc_rad') 
     56      ! 
     57      IF( kt == nittrc000 ) THEN 
    5658         IF(lwp) WRITE(numout,*) 
    5759         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 
     
    6567      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
    6668 
    67  
    6869      ! 
    6970      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     
    7273         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    7374      ENDIF 
     75      ! 
     76      IF( nn_timing == 1 )  CALL timing_stop('trc_rad') 
    7477      ! 
    7578   END SUBROUTINE trc_rad 
     
    104107       
    105108      ! Local declarations 
    106       INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices 
    107       REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars 
     109      INTEGER  :: ji, jj, jk, jn     ! dummy loop indices 
     110      REAL(wp) :: ztrcorb, ztrmasb   ! temporary scalars 
    108111      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    109       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdb  ! workspace arrays 
    110       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdn  ! workspace arrays 
     112      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
    111113      REAL(wp) :: zs2rdt 
    112114      LOGICAL ::   lldebug = .FALSE. 
    113  
    114       !!---------------------------------------------------------------------- 
    115  
    116       IF( l_trdtrc ) THEN 
    117         ! 
    118         ALLOCATE( ztrtrdb(jpi,jpj,jpk) ) 
    119         ALLOCATE( ztrtrdn(jpi,jpj,jpk) ) 
    120         ! 
    121       ENDIF 
     115      !!---------------------------------------------------------------------- 
     116 
     117  
     118      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
    122119       
    123120      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    124121       
    125122         DO jn = jp_sms0, jp_sms1 
    126          !                                                        ! =========== 
     123            !                                                        ! =========== 
    127124            ztrcorb = 0.e0   ;   ztrmasb = 0.e0 
    128125            ztrcorn = 0.e0   ;   ztrmasn = 0.e0 
    129126 
    130            IF( l_trdtrc ) THEN 
    131               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    132               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
    133            ENDIF 
    134  
    135  
    136             DO jk = 1, jpkm1 
    137                DO jj = 1, jpj 
    138                   DO ji = 1, jpi 
    139                      zvolk  = cvol(ji,jj,jk) 
    140 # if defined key_degrad 
    141                      zvolk  = zvolk * facvol(ji,jj,jk) 
    142 # endif 
    143                      ztrcorb = ztrcorb + MIN( 0., ptrb(ji,jj,jk,jn) ) * zvolk 
    144                      ztrcorn = ztrcorn + MIN( 0., ptrn(ji,jj,jk,jn) ) * zvolk 
    145  
    146                      ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 
    147                      ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 
    148  
    149                      ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * zvolk 
    150                      ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * zvolk 
    151                   END DO 
    152                END DO 
    153             END DO 
    154  
    155             IF( lk_mpp ) THEN 
    156                CALL mpp_sum( ztrcorb )      ! sum over the global domain 
    157                CALL mpp_sum( ztrcorn )      ! sum over the global domain 
    158                CALL mpp_sum( ztrmasb )      ! sum over the global domain 
    159                CALL mpp_sum( ztrmasn )      ! sum over the global domain 
    160             ENDIF 
     127            IF( l_trdtrc ) THEN 
     128               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
     129               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
     130            ENDIF 
     131            !                                                         ! sum over the global domain  
     132            ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
     133            ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
     134 
     135            ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
     136            ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
    161137 
    162138            IF( ztrcorb /= 0 ) THEN 
    163139               zcoef = 1. + ztrcorb / ztrmasb 
    164140               DO jk = 1, jpkm1 
     141                  ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 
    165142                  ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
    166143               END DO 
     
    170147               zcoef = 1. + ztrcorn / ztrmasn 
    171148               DO jk = 1, jpkm1 
     149                  ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 
    172150                  ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
    173151               END DO 
     
    207185            IF( l_trdtrc ) THEN 
    208186               ! 
    209                zs2rdt = 1. / ( 2. * rdt * FLOAT(nn_dttrc) ) 
     187               zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 
    210188               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    211189               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     
    219197      ENDIF 
    220198 
    221       IF( l_trdtrc )   DEALLOCATE( ztrtrdb, ztrtrdn ) 
     199      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
    222200 
    223201   END SUBROUTINE trc_rad_sms 
Note: See TracChangeset for help on using the changeset viewer.