- Timestamp:
- 2013-11-18T12:57:11+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r4148 r4230 8 8 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_top … … 30 31 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 31 32 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data 32 INTEGER , SAVE 33 REAL(wp) , SAVE, 34 TYPE(FLD), SAVE, 33 INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 34 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 35 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 35 36 36 37 !! * Substitutions … … 43 44 CONTAINS 44 45 45 SUBROUTINE trc_dta_init 46 SUBROUTINE trc_dta_init(ntrc) 46 47 !!---------------------------------------------------------------------- 47 48 !! *** ROUTINE trc_dta_init *** … … 53 54 !!---------------------------------------------------------------------- 54 55 ! 55 INTEGER :: jl, jn ! dummy loop indicies 56 INTEGER,INTENT(IN) :: ntrc ! number of tracers 57 INTEGER :: jl, jn ! dummy loop indices 56 58 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 57 59 INTEGER :: ios ! Local integer output status for namelist read … … 60 62 ! 61 63 CHARACTER(len=100) :: cn_dir 62 TYPE(FLD_N), DIMENSION(jptra) :: slf_i! array of namelist informations on the fields to read63 TYPE(FLD_N), DIMENSION(jp tra) :: sn_trcdta64 REAL(wp) , DIMENSION(jp tra) :: rn_trfac! multiplicative factor for tracer values64 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 65 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta 66 REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trfac ! multiplicative factor for tracer values 65 67 !! 66 68 NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac … … 72 74 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 73 75 ! Compute the number of tracers to be initialised with data 74 ALLOCATE( n_trc_index( jptra), STAT=ierr0 )76 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 75 77 IF( ierr0 > 0 ) THEN 76 78 CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN … … 78 80 nb_trcdta = 0 79 81 n_trc_index(:) = 0 80 DO jn = 1, jptra82 DO jn = 1, ntrc 81 83 IF( ln_trc_ini(jn) ) THEN 82 84 nb_trcdta = nb_trcdta + 1 … … 92 94 ENDIF 93 95 ! 94 DO jn = 1, jptra95 WRITE( clndta,'("TR_",I1)' ) jn96 clndta = TRIM( clndta )97 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !98 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !99 sn_trcdta(jn) = FLD_N( clndta , -1 , clndta , .false. , .true. , 'monthly' , '' , '' )100 !101 rn_trfac(jn) = 1._wp102 END DO103 !104 96 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 105 97 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) … … 112 104 113 105 IF( lwp ) THEN 114 DO jn = 1, jptra106 DO jn = 1, ntrc 115 107 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 116 108 clndta = TRIM( sn_trcdta(jn)%clvar ) … … 134 126 ENDIF 135 127 ! 136 DO jn = 1, jptra128 DO jn = 1, ntrc 137 129 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 138 130 jl = n_trc_index(jn) … … 152 144 ENDIF 153 145 ! 146 DEALLOCATE( slf_i ) ! deallocate local field structure 154 147 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init') 155 148 ! … … 157 150 158 151 159 SUBROUTINE trc_dta( kt, ptrc )152 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 160 153 !!---------------------------------------------------------------------- 161 154 !! *** ROUTINE trc_dta *** … … 167 160 !! - ln_trcdmp=F: deallocates the data structure as they are not used 168 161 !! 169 !! ** Action : ptrcpassive tracer data on medl mesh and interpolated at time-step kt162 !! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt 170 163 !!---------------------------------------------------------------------- 171 164 INTEGER , INTENT(in ) :: kt ! ocean time-step 172 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: ptrc ! passive tracer data 173 ! 174 INTEGER :: ji, jj, jk, jl, jn, jkk, ik ! dummy loop indicies 165 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 166 REAL(wp) , INTENT(in ) :: zrf_trfac ! multiplication factor 167 ! 168 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 175 169 REAL(wp):: zl, zi 176 170 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace … … 182 176 IF( nb_trcdta > 0 ) THEN 183 177 ! 184 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 185 ! 186 DO jn = 1, ntra 187 ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:) ! NO mask 188 ENDDO 178 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 189 179 ! 190 180 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 195 185 ENDIF 196 186 ! 197 DO jn = 1, ntra198 187 DO jj = 1, jpj ! vertical interpolation of T & S 199 188 DO ji = 1, jpi … … 201 190 zl = fsdept_0(ji,jj,jk) 202 191 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 203 ztp(jk) = ptrc(ji,jj,1 ,jn)192 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 204 193 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 205 ztp(jk) = ptrc(ji,jj,jpkm1,jn)194 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 206 195 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 207 196 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 208 197 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 209 198 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 210 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 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 211 201 ENDIF 212 202 END DO … … 214 204 END DO 215 205 DO jk = 1, jpkm1 216 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord206 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 217 207 END DO 218 ptrc(ji,jj,jpk,jn) = 0._wp208 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 219 209 END DO 220 210 END DO 221 ENDDO222 211 ! 223 212 ELSE !== z- or zps- coordinate ==! 224 213 ! 225 DO jn = 1, ntra 226 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 214 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 227 215 ! 228 216 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level … … 232 220 IF( ik > 1 ) THEN 233 221 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 234 ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn)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) 235 223 ENDIF 236 224 END DO 237 225 END DO 238 226 ENDIF 239 ENDDO240 227 ! 241 228 ENDIF 242 229 ! 243 DO jn = 1, ntra 244 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 245 ENDDO 230 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 246 231 ! 247 232 IF( lwp .AND. kt == nit000 ) THEN 248 DO jn = 1, ntra 249 clndta = TRIM( sf_trcdta(jn)%clvar ) 233 clndta = TRIM( sf_dta(1)%clvar ) 250 234 WRITE(numout,*) ''//clndta//' data ' 251 235 WRITE(numout,*) 252 236 WRITE(numout,*)' level = 1' 253 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )237 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 254 238 WRITE(numout,*)' level = ', jpk/2 255 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )239 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 256 240 WRITE(numout,*)' level = ', jpkm1 257 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )241 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 258 242 WRITE(numout,*) 259 ENDDO 260 ENDIF 261 262 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 263 ! (data used only for initialisation) 264 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 265 DO jn = 1, ntra 266 DEALLOCATE( sf_trcdta(jn)%fnow ) ! arrays in the structure 267 IF( sf_trcdta(jn)%ln_tint ) DEALLOCATE( sf_trcdta(jn)%fdta ) 268 ENDDO 269 DEALLOCATE( sf_trcdta ) ! the structure itself 270 ! 271 ENDIF 272 ! 273 ENDIF 274 ! 243 ENDIF 244 ENDIF 245 ! 275 246 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 276 247 ! … … 281 252 !!---------------------------------------------------------------------- 282 253 CONTAINS 283 SUBROUTINE trc_dta( kt ) ! Empty routine254 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) ! Empty routine 284 255 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 285 256 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
