- Timestamp:
- 2019-02-27T12:39:03+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
r10685 r10724 23 23 USE wrk_nemo ! Memory allocation 24 24 USE timing ! Timing 25 USE iom26 25 27 26 IMPLICIT NONE … … 32 31 33 32 LOGICAL , PUBLIC :: ln_tsd_init !: T & S data flag 34 LOGICAL , PUBLIC :: ln_tsd_interp !: vertical interpolation flag35 33 LOGICAL , PUBLIC :: ln_tsd_tradmp !: internal damping toward input data flag 36 34 37 35 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tsd ! structure of input SST (file informations, fields read) 38 INTEGER :: jpk_init , inum_dta39 INTEGER :: id ,linum ! local integers40 INTEGER :: zdim(4)41 36 42 37 !!---------------------------------------------------------------------- … … 58 53 LOGICAL, INTENT(in), OPTIONAL :: ld_tradmp ! force the initialization when tradp is used 59 54 ! 60 INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 , ierr4, ierr5! local integers55 INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers 61 56 !! 62 57 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 63 TYPE(FLD_N), DIMENSION(jpts+2):: slf_i ! array of namelist informations on the fields to read 64 TYPE(FLD_N) :: sn_tem, sn_sal, sn_dep, sn_msk 65 58 TYPE(FLD_N), DIMENSION( jpts) :: slf_i ! array of namelist informations on the fields to read 59 TYPE(FLD_N) :: sn_tem, sn_sal 66 60 !! 67 NAMELIST/namtsd/ ln_tsd_init, ln_tsd_ interp, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal, sn_dep, sn_msk61 NAMELIST/namtsd/ ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 68 62 !!---------------------------------------------------------------------- 69 63 ! … … 71 65 ! 72 66 ! Initialisation 73 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 ; ierr4 = 0 ; ierr5 = 067 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 74 68 ! 75 69 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist : … … 90 84 WRITE(numout,*) ' Namelist namtsd' 91 85 WRITE(numout,*) ' Initialisation of ocean T & S with T &S input data ln_tsd_init = ', ln_tsd_init 92 WRITE(numout,*) ' iInterpolation of initial conditions in the vertical ln_tsd_interp = ', ln_tsd_interp93 86 WRITE(numout,*) ' damping of ocean T & S toward T &S input data ln_tsd_tradmp = ', ln_tsd_tradmp 94 87 WRITE(numout,*) … … 104 97 ln_tsd_init = .FALSE. 105 98 ENDIF 106 IF( ln_tsd_interp .AND. ln_tsd_tradmp ) THEN107 CALL ctl_stop( 'dta_tsd_init: Tracer damping and vertical interpolation not yet configured' ) ; RETURN108 ENDIF109 IF( ln_tsd_interp .AND. LEN(TRIM(sn_msk%wname)) > 0 ) THEN110 CALL ctl_stop( 'dta_tsd_init: Using vertical interpolation and weights files not recommended' ) ; RETURN111 ENDIF112 99 ! 113 100 ! ! allocate the arrays (if necessary) 114 101 IF( ln_tsd_init .OR. ln_tsd_tradmp ) THEN 115 102 ! 116 IF( ln_tsd_interp ) THEN 117 ALLOCATE( sf_tsd(jpts+2), STAT=ierr0 ) ! to carry the addtional depth information 118 ELSE 119 ALLOCATE( sf_tsd(jpts ), STAT=ierr0 ) 120 ENDIF 103 ALLOCATE( sf_tsd(jpts), STAT=ierr0 ) 121 104 IF( ierr0 > 0 ) THEN 122 105 CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' ) ; RETURN 123 106 ENDIF 124 107 ! 125 IF( ln_tsd_interp ) THEN 126 CALL iom_open ( trim(cn_dir) // trim(sn_dep%clname), inum_dta ) 127 id = iom_varid( inum_dta, sn_dep%clvar, zdim ) 128 jpk_init = zdim(3) 129 IF(lwp) WRITE(numout,*) 'Dimension of veritcal coordinate in ICs: ', jpk_init 130 CALL iom_close( inum_dta ) ! Close the input file 131 ! 132 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk_init ) , STAT=ierr0 ) 133 IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr1 ) 134 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk_init ) , STAT=ierr2 ) 135 IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr3 ) 136 ALLOCATE( sf_tsd(jp_dep)%fnow(jpi,jpj,jpk_init ) , STAT=ierr4 ) 137 ALLOCATE( sf_tsd(jp_msk)%fnow(jpi,jpj,jpk_init ) , STAT=ierr5 ) 138 ELSE 139 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 140 IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 141 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 142 IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 143 ENDIF ! ln_tsd_interp 144 145 ! 146 IF( ierr0 + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 > 0 ) THEN 108 ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 109 IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 110 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 111 IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 112 ! 113 IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN 147 114 CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' ) ; RETURN 148 115 ENDIF 149 116 ! ! fill sf_tsd with sn_tem & sn_sal and control print 150 117 slf_i(jp_tem) = sn_tem ; slf_i(jp_sal) = sn_sal 151 IF( ln_tsd_interp ) slf_i(jp_dep) = sn_dep ; slf_i(jp_msk) = sn_msk152 118 CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print ) 153 119 ! … … 177 143 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data 178 144 ! 179 INTEGER :: ji, jj, jk, jl, jk _init! dummy loop indicies180 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 145 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 146 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 181 147 REAL(wp):: zl, zi 148 REAL(wp), POINTER, DIMENSION(:) :: ztp, zsp ! 1D workspace 182 149 !!---------------------------------------------------------------------- 183 150 ! … … 214 181 !!gm end 215 182 ! 216 IF( kt == nit000 .AND. lwp )THEN 217 WRITE(numout,*) 218 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto current mesh' 219 ENDIF 220 ! 221 IF( ln_tsd_interp ) THEN ! probably should use pointers in the following to make more readable 222 ! 223 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 224 DO jj= 1, jpj 225 DO ji= 1, jpi 183 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) ! NO mask 184 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) 185 ! 186 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 ! 188 CALL wrk_alloc( jpk, ztp, zsp ) 189 ! 190 IF( kt == nit000 .AND. lwp )THEN 191 WRITE(numout,*) 192 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 193 ENDIF 194 ! 195 DO jj = 1, jpj ! vertical interpolation of T & S 196 DO ji = 1, jpi 197 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 226 198 zl = gdept_0(ji,jj,jk) 227 IF( zl < sf_tsd(jp_dep)%fnow(ji,jj,1) ) THEN ! above the first level of data 228 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,1) 229 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,1) 230 ELSEIF( zl > sf_tsd(jp_dep)%fnow(ji,jj,jpk_init) ) THEN ! below the last level of data 231 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jpk_init) 232 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jpk_init) 233 ELSE ! inbetween : vertical interpolation between jk_init & jk_init+1 234 DO jk_init = 1, jpk_init-1 ! when gdept(jk_init) < zl < gdept(jk_init+1) 235 IF( sf_tsd(jp_msk)%fnow(ji,jj,jk_init+1) == 0 ) THEN ! if there is no data fill down 236 sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) 237 sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) 238 ENDIF 239 IF( (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) * (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)) <= 0._wp ) THEN 240 zi = ( zl - sf_tsd(jp_dep)%fnow(ji,jj,jk_init) ) / & 241 & (sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) 242 ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) + & 243 & (sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_tem)%fnow(ji,jj,jk_init)) * zi 244 ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) + & 245 & (sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_sal)%fnow(ji,jj,jk_init)) * zi 199 IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data 200 ztp(jk) = ptsd(ji,jj,1 ,jp_tem) 201 zsp(jk) = ptsd(ji,jj,1 ,jp_sal) 202 ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data 203 ztp(jk) = ptsd(ji,jj,jpkm1,jp_tem) 204 zsp(jk) = ptsd(ji,jj,jpkm1,jp_sal) 205 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 206 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 207 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 208 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 209 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 210 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 246 211 ENDIF 247 212 END DO 248 213 ENDIF 249 ENDDO 250 ENDDO 214 END DO 215 DO jk = 1, jpkm1 216 ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 217 ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 218 END DO 219 ptsd(ji,jj,jpk,jp_tem) = 0._wp 220 ptsd(ji,jj,jpk,jp_sal) = 0._wp 221 END DO 251 222 END DO 252 ! 253 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) *tmask(:,:,:)254 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) *tmask(:,:,:)223 ! 224 CALL wrk_dealloc( jpk, ztp, zsp ) 225 ! 255 226 ELSE !== z- or zps- coordinate ==! 256 227 ! 257 ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:) * tmask(:,:,:)! Mask258 ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)* tmask(:,:,:)228 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 229 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 259 230 ! 260 231 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level … … 286 257 DEALLOCATE( sf_tsd(jp_sal)%fnow ) ! S arrays in the structure 287 258 IF( sf_tsd(jp_sal)%ln_tint ) DEALLOCATE( sf_tsd(jp_sal)%fdta ) 288 IF( ln_tsd_interp ) DEALLOCATE( sf_tsd(jp_dep)%fnow ) ! T arrays in the structure289 IF( ln_tsd_interp ) DEALLOCATE( sf_tsd(jp_msk)%fnow ) ! T arrays in the structure290 259 DEALLOCATE( sf_tsd ) ! the structure itself 291 260 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
