- Timestamp:
- 2017-12-26T17:32:56+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r9125 r9169 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- 34 35 34 CONTAINS 36 35 … … 50 49 !! (the total CFC content is not strictly preserved) 51 50 !!---------------------------------------------------------------------- 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index 51 INTEGER, INTENT(in) :: kt ! ocean time-step index 52 ! 53 53 CHARACTER (len=22) :: charout 54 54 !!---------------------------------------------------------------------- … … 56 56 IF( ln_timing ) CALL timing_start('trc_rad') 57 57 ! 58 IF( kt == nittrc000 ) THEN 59 IF(lwp) WRITE(numout,*) 60 IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 61 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 62 ENDIF 63 64 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE 58 IF( ln_age ) CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age ) ! AGE 65 59 IF( ll_cfc ) CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1 ) ! CFC model 66 IF( ln_c14 ) CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14 ) ! C1460 IF( ln_c14 ) CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14 ) ! C14 67 61 IF( ln_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' ) ! PISCES model 68 62 IF( ln_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1 ) ! MY_TRC model 69 70 63 ! 71 64 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 79 72 END SUBROUTINE trc_rad 80 73 74 81 75 SUBROUTINE trc_rad_ini 82 76 !!--------------------------------------------------------------------- 83 77 !! *** ROUTINE trc _rad_ini *** 84 78 !! 85 !! ** Purpose : read namelist options 86 !!---------------------------------------------------------------------- 87 INTEGER :: ios ! Local integer output status for namelist read 79 !! ** Purpose : read namelist options 80 !!---------------------------------------------------------------------- 81 INTEGER :: ios ! Local integer output status for namelist read 82 !! 88 83 NAMELIST/namtrc_rad/ ln_trcrad 89 84 !!---------------------------------------------------------------------- 90 91 85 ! 92 86 REWIND( numnat_ref ) ! namtrc_rad in reference namelist 93 87 READ ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 94 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 95 88 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 96 89 REWIND( numnat_cfg ) ! namtrc_rad in configuration namelist 97 90 READ ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 98 908 IF( ios /= 0 )CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp )99 IF(lwm) WRITE 91 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 92 IF(lwm) WRITE( numont, namtrc_rad ) 100 93 101 94 IF(lwp) THEN ! ! Control print 102 95 WRITE(numout,*) 96 WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 97 WRITE(numout,*) '~~~~~~~ ' 103 98 WRITE(numout,*) ' Namelist namtrc_rad : treatment of negative concentrations' 104 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 99 WRITE(numout,*) ' correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 100 WRITE(numout,*) 101 IF( ln_trcrad ) THEN ; WRITE(numout,*) ' ===>> ensure the global tracer conservation' 102 ELSE ; WRITE(numout,*) ' ===>> NO strict global tracer conservation' 103 ENDIF 105 104 ENDIF 106 105 ! 107 106 END SUBROUTINE trc_rad_ini 107 108 108 109 109 SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) … … 123 123 !! (the total content of concentration is not strictly preserved) 124 124 !!-------------------------------------------------------------------------------- 125 !! Arguments 126 INTEGER, INTENT( in ) :: kt ! ocean time-step index 127 INTEGER , INTENT( in ) :: & 128 jp_sms0, & !: First index of the passive tracer model 129 jp_sms1 !: Last index of the passive tracer model 130 131 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT( inout ) :: & 132 ptrb, ptrn !: before and now traceur concentration 133 134 CHARACTER( len = 1) , INTENT(in), OPTIONAL :: & 135 cpreserv !: flag to preserve content or not 136 137 ! Local declarations 138 INTEGER :: ji, jj, jk, jn ! dummy loop indices 139 REAL(wp) :: ztrcorb, ztrmasb ! temporary scalars 140 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 125 INTEGER , INTENT(in ) :: kt ! ocean time-step index 126 INTEGER , INTENT(in ) :: jp_sms0, jp_sms1 ! First & last index of the passive tracer model 127 REAL(wp), DIMENSION (jpi,jpj,jpk,jptra), INTENT(inout) :: ptrb , ptrn ! before and now traceur concentration 128 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 129 ! 130 INTEGER :: ji, jj, jk, jn ! dummy loop indices 131 LOGICAL :: lldebug = .FALSE. ! local logical 132 REAL(wp):: ztrcorb, ztrmasb, zs2rdt ! temporary scalars 133 REAL(wp):: zcoef , ztrcorn, ztrmasn ! - - 141 134 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 142 REAL(wp) :: zs2rdt 143 LOGICAL :: lldebug = .FALSE. 144 !!---------------------------------------------------------------------- 145 146 147 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 148 149 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved 150 135 !!---------------------------------------------------------------------- 136 ! 137 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 138 ! 139 IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==! 140 ! 151 141 DO jn = jp_sms0, jp_sms1 152 ! ! ===========153 ztrcorb = 0. e0 ; ztrmasb = 0.e0154 ztrcorn = 0. e0 ; ztrmasn = 0.e0155 142 ! 143 ztrcorb = 0._wp ; ztrmasb = 0._wp 144 ztrcorn = 0._wp ; ztrmasn = 0._wp 145 ! 156 146 IF( l_trdtrc ) THEN 157 147 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation … … 161 151 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 162 152 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 163 153 ! 164 154 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 165 155 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 166 156 ! 167 157 IF( ztrcorb /= 0 ) THEN 168 158 zcoef = 1. + ztrcorb / ztrmasb … … 172 162 END DO 173 163 ENDIF 174 164 ! 175 165 IF( ztrcorn /= 0 ) THEN 176 166 zcoef = 1. + ztrcorn / ztrmasn … … 190 180 ! 191 181 ENDIF 192 182 ! 193 183 END DO 194 184 ! 195 ! 196 ELSE ! total CFC content is not strictly preserved 197 185 ELSE !== total CFC content is NOT strictly preserved ==! 186 ! 198 187 DO jn = jp_sms0, jp_sms1 199 200 IF( l_trdtrc ) THEN201 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation202 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation203 ENDIF204 188 ! 189 IF( l_trdtrc ) THEN 190 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 191 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 192 ENDIF 193 ! 205 194 DO jk = 1, jpkm1 206 195 DO jj = 1, jpj … … 211 200 END DO 212 201 END DO 213 202 ! 214 203 IF( l_trdtrc ) THEN 215 204 ! … … 222 211 ENDIF 223 212 ! 224 END DO225 213 END DO 214 ! 226 215 ENDIF 227 216 ! 228 217 IF( l_trdtrc ) DEALLOCATE( ztrtrdb, ztrtrdn ) 229 218 ! 230 219 END SUBROUTINE trc_rad_sms 220 231 221 #else 232 222 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
