- Timestamp:
- 2013-11-11T12:13:04+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r3882 r4176 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 59 INTEGER :: ios ! Local integer output status for namelist read 57 60 CHARACTER(len=100) :: clndta, clntrc 58 61 REAL(wp) :: zfact 59 62 ! 60 63 CHARACTER(len=100) :: cn_dir 61 TYPE(FLD_N), DIMENSION(jptra) :: slf_i! array of namelist informations on the fields to read62 TYPE(FLD_N), DIMENSION(jp tra) :: sn_trcdta63 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 64 67 !! 65 68 NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac … … 71 74 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 72 75 ! Compute the number of tracers to be initialised with data 73 ALLOCATE( n_trc_index( jptra), STAT=ierr0 )76 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 74 77 IF( ierr0 > 0 ) THEN 75 78 CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN … … 77 80 nb_trcdta = 0 78 81 n_trc_index(:) = 0 79 DO jn = 1, jptra82 DO jn = 1, ntrc 80 83 IF( ln_trc_ini(jn) ) THEN 81 84 nb_trcdta = nb_trcdta + 1 … … 93 96 ! 94 97 cn_dir = './' ! directory in which the model is executed 95 DO jn = 1, jptra98 DO jn = 1, ntrc 96 99 WRITE( clndta,'("TR_",I1)' ) jn 97 100 clndta = TRIM( clndta ) … … 103 106 END DO 104 107 ! 108 !MAV temporary code for 3.5 105 109 REWIND( numnat ) ! read nattrc 106 110 READ ( numnat, namtrc_dta ) 111 !MAV future code for 3.6 112 ! REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer data 113 ! READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 114 !901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 115 ! 116 ! REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer data 117 ! READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 118 !902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 119 ! WRITE ( numont, namtrc_dta ) 107 120 108 121 IF( lwp ) THEN 109 DO jn = 1, jptra122 DO jn = 1, ntrc 110 123 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 111 124 clndta = TRIM( sn_trcdta(jn)%clvar ) … … 129 142 ENDIF 130 143 ! 131 DO jn = 1, jptra144 DO jn = 1, ntrc 132 145 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 133 146 jl = n_trc_index(jn) … … 147 160 ENDIF 148 161 ! 162 DEALLOCATE( slf_i ) ! deallocate local field structure 149 163 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init') 150 164 ! … … 152 166 153 167 154 SUBROUTINE trc_dta( kt, ptrc )168 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 155 169 !!---------------------------------------------------------------------- 156 170 !! *** ROUTINE trc_dta *** … … 162 176 !! - ln_trcdmp=F: deallocates the data structure as they are not used 163 177 !! 164 !! ** Action : ptrcpassive tracer data on medl mesh and interpolated at time-step kt178 !! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt 165 179 !!---------------------------------------------------------------------- 166 180 INTEGER , INTENT(in ) :: kt ! ocean time-step 167 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: ptrc ! passive tracer data 168 ! 169 INTEGER :: ji, jj, jk, jl, jn, jkk, ik ! dummy loop indicies 181 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 182 REAL(wp) , INTENT(in ) :: zrf_trfac ! multiplication factor 183 ! 184 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 170 185 REAL(wp):: zl, zi 171 186 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace … … 177 192 IF( nb_trcdta > 0 ) THEN 178 193 ! 179 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 180 ! 181 DO jn = 1, ntra 182 ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:) ! NO mask 183 ENDDO 194 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 184 195 ! 185 196 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 190 201 ENDIF 191 202 ! 192 DO jn = 1, ntra193 203 DO jj = 1, jpj ! vertical interpolation of T & S 194 204 DO ji = 1, jpi … … 196 206 zl = fsdept_0(ji,jj,jk) 197 207 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptrc(ji,jj,1 ,jn)208 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 199 209 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptrc(ji,jj,jpkm1,jn)210 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 201 211 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 202 212 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 203 213 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 204 214 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 205 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 215 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 216 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 206 217 ENDIF 207 218 END DO … … 209 220 END DO 210 221 DO jk = 1, jpkm1 211 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord222 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 212 223 END DO 213 ptrc(ji,jj,jpk,jn) = 0._wp224 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 214 225 END DO 215 226 END DO 216 ENDDO217 227 ! 218 228 ELSE !== z- or zps- coordinate ==! 219 229 ! 220 DO jn = 1, ntra 221 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 230 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 222 231 ! 223 232 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level … … 227 236 IF( ik > 1 ) THEN 228 237 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 229 ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn)238 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) 230 239 ENDIF 231 240 END DO 232 241 END DO 233 242 ENDIF 234 ENDDO235 243 ! 236 244 ENDIF 237 245 ! 238 DO jn = 1, ntra 239 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 240 ENDDO 246 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 241 247 ! 242 248 IF( lwp .AND. kt == nit000 ) THEN 243 DO jn = 1, ntra 244 clndta = TRIM( sf_trcdta(jn)%clvar ) 249 clndta = TRIM( sf_dta(1)%clvar ) 245 250 WRITE(numout,*) ''//clndta//' data ' 246 251 WRITE(numout,*) 247 252 WRITE(numout,*)' level = 1' 248 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )253 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 249 254 WRITE(numout,*)' level = ', jpk/2 250 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )255 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 251 256 WRITE(numout,*)' level = ', jpkm1 252 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )257 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 253 258 WRITE(numout,*) 254 ENDDO 255 ENDIF 256 257 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 258 ! (data used only for initialisation) 259 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 260 DO jn = 1, ntra 261 DEALLOCATE( sf_trcdta(jn)%fnow ) ! arrays in the structure 262 IF( sf_trcdta(jn)%ln_tint ) DEALLOCATE( sf_trcdta(jn)%fdta ) 263 ENDDO 264 DEALLOCATE( sf_trcdta ) ! the structure itself 265 ! 266 ENDIF 267 ! 268 ENDIF 269 ! 259 ENDIF 260 ENDIF 261 ! 270 262 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 271 263 ! … … 276 268 !!---------------------------------------------------------------------- 277 269 CONTAINS 278 SUBROUTINE trc_dta( kt ) ! Empty routine270 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) ! Empty routine 279 271 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 280 272 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
