- Timestamp:
- 2016-11-04T18:58:24+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r6701 r7198 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 11 !! 3.6 ! 2015-03 (T. Lovato) revisi on of code log info11 !! 3.6 ! 2015-03 (T. Lovato) revisit code I/O 12 12 !!---------------------------------------------------------------------- 13 13 #if defined key_top … … 28 28 29 29 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 30 PUBLIC trc_dta_ini t! called in trcini.F9030 PUBLIC trc_dta_ini ! called in trcini.F90 31 31 32 32 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data … … 45 45 CONTAINS 46 46 47 SUBROUTINE trc_dta_ini t(ntrc)48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini t***47 SUBROUTINE trc_dta_ini(ntrc) 48 !!---------------------------------------------------------------------- 49 !! *** ROUTINE trc_dta_ini *** 50 50 !! 51 51 !! ** Purpose : initialisation of passive tracer input data … … 70 70 !!---------------------------------------------------------------------- 71 71 ! 72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini t')72 IF( nn_timing == 1 ) CALL timing_start('trc_dta_ini') 73 73 ! 74 74 IF( lwp ) THEN 75 75 WRITE(numout,*) ' ' 76 WRITE(numout,*) ' trc_dta_ini t: Tracers Initial Conditions (IC)'76 WRITE(numout,*) ' trc_dta_ini : Tracers Initial Conditions (IC)' 77 77 WRITE(numout,*) ' ~~~~~~~~~~~ ' 78 78 ENDIF … … 83 83 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 84 84 IF( ierr0 > 0 ) THEN 85 CALL ctl_stop( 'trc_dta_ini t: unable to allocate n_trc_index' ) ; RETURN85 CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' ) ; RETURN 86 86 ENDIF 87 87 nb_trcdta = 0 … … 103 103 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 104 104 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin reference namelist', lwp )105 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 106 106 107 107 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 108 108 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini tin configuration namelist', lwp )109 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 110 110 IF(lwm) WRITE ( numont, namtrc_dta ) 111 111 … … 118 118 zfact = rn_trfac(jn) 119 119 IF( clndta /= clntrc ) THEN 120 CALL ctl_warn( 'trc_dta_ini t: passive tracer data initialisation ', &120 CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation ', & 121 121 & 'Input name of data file : '//TRIM(clndta)// & 122 122 & ' differs from that of tracer : '//TRIM(clntrc)//' ') … … 132 132 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 133 133 IF( ierr1 > 0 ) THEN 134 CALL ctl_stop( 'trc_dta_ini t: unable to allocate sf_trcdta structure' ) ; RETURN134 CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN 135 135 ENDIF 136 136 ! … … 143 143 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 144 144 IF( ierr2 + ierr3 > 0 ) THEN 145 CALL ctl_stop( 'trc_dta_ini t: unable to allocate passive tracer data arrays' ) ; RETURN145 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' ) ; RETURN 146 146 ENDIF 147 147 ENDIF … … 149 149 ENDDO 150 150 ! ! fill sf_trcdta with slf_i and control print 151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini t', 'Passive tracer data', 'namtrc' )151 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' ) 152 152 ! 153 153 ENDIF 154 154 ! 155 155 DEALLOCATE( slf_i ) ! deallocate local field structure 156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini t')157 ! 158 END SUBROUTINE trc_dta_ini t159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)156 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_ini') 157 ! 158 END SUBROUTINE trc_dta_ini 159 160 161 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) 162 162 !!---------------------------------------------------------------------- 163 163 !! *** ROUTINE trc_dta *** … … 169 169 !! - ln_trcdmp=F: deallocates the data structure as they are not used 170 170 !! 171 !! ** Action : sf_trcdta passive tracer data on me dlmesh and interpolated at time-step kt172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt! ocean time-step174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta! array of information on the field to read175 REAL(wp) , INTENT(in ) :: ptrfac! multiplication factor176 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc171 !! ** Action : sf_trcdta passive tracer data on meld mesh and interpolated at time-step kt 172 !!---------------------------------------------------------------------- 173 INTEGER , INTENT(in ) :: kt ! ocean time-step 174 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read 175 REAL(wp) , INTENT(in ) :: ztrcfac ! multiplication factor 176 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ztrcdta ! 3D data array 177 177 ! 178 178 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 179 179 REAL(wp):: zl, zi 180 180 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace182 181 CHARACTER(len=100) :: clndta 183 182 !!---------------------------------------------------------------------- … … 187 186 IF( nb_trcdta > 0 ) THEN 188 187 ! 189 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 190 ! 191 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 192 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 193 ! 194 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 188 ! read data at kt time step 189 CALL fld_read( kt, 1, sf_trcdta ) 190 ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 191 ! 192 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 195 193 ! 196 194 IF( kt == nit000 .AND. lwp )THEN … … 205 203 ztp(jk) = ztrcdta(ji,jj,1) 206 204 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 207 ztp(jk) = 205 ztp(jk) = ztrcdta(ji,jj,jpkm1) 208 206 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 209 207 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 210 208 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 211 209 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 212 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 213 ztrcdta(ji,jj,jkk) ) * zi 210 ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - ztrcdta(ji,jj,jkk) ) * zi 214 211 ENDIF 215 212 END DO … … 217 214 END DO 218 215 DO jk = 1, jpkm1 219 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord216 ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 220 217 END DO 221 218 ztrcdta(ji,jj,jpk) = 0._wp … … 224 221 ! 225 222 ELSE !== z- or zps- coordinate ==! 226 ! 227 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level223 ! zps-coordinate (partial steps) interpolation at the last ocean level 224 IF( ln_zps ) THEN 228 225 DO jj = 1, jpj 229 226 DO ji = 1, jpi … … 244 241 ENDIF 245 242 ! 246 ! Add multiplicative factor 247 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 248 ! 249 ! Data structure for trc_ini (and BFMv5.1 coupling) 250 IF( .NOT. PRESENT(ptrc) ) sf_trcdta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 251 ! 252 ! Data structure for trc_dmp 253 IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:) 254 ! 255 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 243 ! Scale by multiplicative factor 244 ztrcdta(:,:,:) = ztrcdta(:,:,:) * ztrcfac 256 245 ! 257 246 ENDIF … … 266 255 !!---------------------------------------------------------------------- 267 256 CONTAINS 268 SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) ! Empty routine257 SUBROUTINE trc_dta( kt, sf_trcdta, ztrcfac, ztrcdta) ! Empty routine 269 258 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 270 259 END SUBROUTINE trc_dta
Note: See TracChangeset
for help on using the changeset viewer.
