Changeset 7083 for branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
- Timestamp:
- 2016-10-25T12:12:41+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_MEDUSA_extra_CMIP6_diags/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6498 r7083 77 77 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 78 78 IF( ierr0 > 0 ) THEN 79 CALL ctl_stop( 'trc_ nam: unable to allocate n_trc_index' ) ; RETURN79 CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN 80 80 ENDIF 81 81 nb_trcdta = 0 … … 91 91 IF(lwp) THEN 92 92 WRITE(numout,*) ' ' 93 WRITE(numout,*) 'trc_dta_init : Passive tracers Initial Conditions ' 94 WRITE(numout,*) '~~~~~~~~~~~~~~ ' 93 95 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 94 96 WRITE(numout,*) ' ' … … 107 109 DO jn = 1, ntrc 108 110 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 109 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 clntrc = TRIM( ctrcnm (jn) ) 111 clndta = TRIM( sn_trcdta(jn)%clvar ) 112 if (jn > jptra) then 113 clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 114 else 115 clntrc = TRIM( ctrcnm (jn) ) 116 endif 111 117 zfact = rn_trfac(jn) 112 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :', &114 & ' the variable name in the data file : '//clndta// &115 & ' must be the same than the name of the passive tracer : '//clntrc//' ')118 IF( clndta /= clntrc ) THEN 119 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', & 120 & 'Input name of data file : '//TRIM(clndta)// & 121 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 116 122 ENDIF 117 WRITE(numout, *) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &118 & ' multiplicativefactor : ', zfact123 WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', & 124 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 119 125 ENDIF 120 126 END DO … … 124 130 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 131 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini : unable to allocate sf_trcdta structure' ) ; RETURN132 CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN 127 133 ENDIF 128 134 ! … … 135 141 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 142 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN143 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN 138 144 ENDIF 139 145 ENDIF … … 141 147 ENDDO 142 148 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta ', 'Passive tracer data', 'namtrc' )149 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 144 150 ! 145 151 ENDIF … … 151 157 152 158 153 SUBROUTINE trc_dta( kt, sf_dta 159 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) 154 160 !!---------------------------------------------------------------------- 155 161 !! *** ROUTINE trc_dta *** … … 164 170 !!---------------------------------------------------------------------- 165 171 INTEGER , INTENT(in ) :: kt ! ocean time-step 166 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 172 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 173 REAL(wp) , INTENT(in ) :: ptrfac ! multiplication factor 174 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc 167 175 ! 168 176 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 169 177 REAL(wp):: zl, zi 170 178 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 179 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 171 180 CHARACTER(len=100) :: clndta 172 181 !!---------------------------------------------------------------------- … … 176 185 IF( nb_trcdta > 0 ) THEN 177 186 ! 187 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 188 ! 178 189 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 190 ztrcdta(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 179 191 ! 180 192 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 185 197 ENDIF 186 198 ! 187 DO jj = 1, jpj ! vertical interpolation of T & S 199 DO jj = 1, jpj ! vertical interpolation of T & S 200 DO ji = 1, jpi 201 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 202 zl = fsdept_n(ji,jj,jk) 203 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 204 ztp(jk) = ztrcdta(ji,jj,1) 205 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 206 ztp(jk) = ztrcdta(ji,jj,jpkm1) 207 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 208 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 209 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 210 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 211 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 212 ztrcdta(ji,jj,jkk) ) * zi 213 ENDIF 214 END DO 215 ENDIF 216 END DO 217 DO jk = 1, jpkm1 218 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 219 END DO 220 ztrcdta(ji,jj,jpk) = 0._wp 221 END DO 222 END DO 223 ! 224 ELSE !== z- or zps- coordinate ==! 225 ! 226 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 227 DO jj = 1, jpj 188 228 DO ji = 1, jpi 189 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 190 zl = fsdept_n(ji,jj,jk) 191 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 193 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 194 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 195 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 196 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 197 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 198 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 199 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 200 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 201 ENDIF 202 END DO 203 ENDIF 204 END DO 205 DO jk = 1, jpkm1 206 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 207 END DO 208 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 229 ik = mbkt(ji,jj) 230 IF( ik > 1 ) THEN 231 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 232 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 233 ENDIF 234 ik = mikt(ji,jj) 235 IF( ik > 1 ) THEN 236 zl = ( fsdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 237 ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 238 ENDIF 209 239 END DO 210 240 END DO 211 ! 212 ELSE !== z- or zps- coordinate ==! 213 ! 214 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 215 ! 216 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 ik = mbkt(ji,jj) 220 IF( ik > 1 ) THEN 221 zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 222 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 223 ENDIF 224 ik = mikt(ji,jj) 225 IF( ik > 1 ) THEN 226 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 227 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1) 228 ENDIF 229 END DO 230 END DO 231 ENDIF 232 ! 233 ENDIF 241 ENDIF 242 ! 243 ENDIF 244 ! 245 ! Add multiplicative factor 246 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 247 ! 248 ! Data structure for trc_ini (and BFMv5.1 coupling) 249 IF( .NOT. PRESENT(ptrc) ) sf_dta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 250 ! 251 ! Data structure for trc_dmp 252 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 234 253 ! 235 254 IF( lwp .AND. kt == nit000 ) THEN … … 238 257 WRITE(numout,*) 239 258 WRITE(numout,*)' level = 1' 240 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )259 CALL prihre( ztrcdta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 241 260 WRITE(numout,*)' level = ', jpk/2 242 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )261 CALL prihre( ztrcdta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 243 262 WRITE(numout,*)' level = ', jpkm1 244 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )263 CALL prihre( ztrcdta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 264 WRITE(numout,*) 246 265 ENDIF 266 ! 267 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 268 ! 247 269 ENDIF 248 270 ! … … 255 277 !!---------------------------------------------------------------------- 256 278 CONTAINS 257 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac) ! Empty routine279 SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) ! Empty routine 258 280 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 259 281 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
