Changeset 1951 for branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DTA
- Timestamp:
- 2010-06-24T17:00:16+02:00 (14 years ago)
- Location:
- branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DTA
- Files:
-
- 2 edited
-
dtasal.F90 (modified) (3 diffs)
-
dtatem.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DTA/dtasal.F90
r1715 r1951 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 15 16 USE in_out_manager ! I/O manager 16 17 USE phycst ! physical constants … … 27 28 !! * Shared module variables 28 29 LOGICAL , PUBLIC, PARAMETER :: lk_dtasal = .TRUE. !: salinity data flag 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 30 s_dta !: salinity data at given time-step 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: s_dta !: salinity data at given time-step 31 31 32 32 !! * Module variables 33 INTEGER :: & 34 numsdt, & !: logical unit for data salinity 35 nsal1, nsal2 ! first and second record used 36 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 37 saldta ! salinity data at two consecutive times 33 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sal ! structure of input SST (file informations, fields read) 38 34 39 35 !! * Substitutions … … 52 48 53 49 SUBROUTINE dta_sal( kt ) 54 !!---------------------------------------------------------------------- 55 !! *** ROUTINE dta_sal *** 56 !! 57 !! ** Purpose : Reads monthly salinity data 58 !! 59 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 60 !! lated onto the model grid. 61 !! - At each time step, a linear interpolation is applied 62 !! between two monthly values. 63 !! 64 !! History : 65 !! ! 91-03 () Original code 66 !! ! 92-07 (M. Imbard) 67 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 68 !!---------------------------------------------------------------------- 69 !! * Modules used 70 USE iom 71 72 !! * Arguments 73 INTEGER, INTENT(in) :: kt ! ocean time step 74 75 !! * Local declarations 76 77 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 78 INTEGER :: & 79 imois, iman, i15, ik ! temporary integers 80 # if defined key_tradmp 81 INTEGER :: & 82 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 83 # endif 84 REAL(wp) :: zxy, zl 85 #if defined key_orca_lev10 86 REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 87 INTEGER :: ikr, ikw, ikt, jjk 88 REAL(wp) :: zfac 89 #endif 90 REAL(wp), DIMENSION(jpk,2) :: & 91 zsaldta ! auxiliary array for interpolation 92 !!---------------------------------------------------------------------- 93 94 ! 0. Initialization 95 ! ----------------- 96 97 iman = INT( raamo ) 98 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 99 i15 = nday / 16 100 imois = nmonth + i15 - 1 101 IF( imois == 0 ) imois = iman 102 103 ! 1. First call kt=nit000 104 ! ----------------------- 105 106 IF( kt == nit000 ) THEN 107 108 nsal1 = 0 ! initializations 109 IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 110 CALL iom_open ( 'data_1m_salinity_nomask', numsdt ) 111 112 ENDIF 113 114 115 ! 2. Read monthly file 116 ! ------------------- 117 118 IF( kt == nit000 .OR. imois /= nsal1 ) THEN 119 120 ! 2.1 Calendar computation 121 122 nsal1 = imois ! first file record used 123 nsal2 = nsal1 + 1 ! last file record used 124 nsal1 = MOD( nsal1, iman ) 125 IF( nsal1 == 0 ) nsal1 = iman 126 nsal2 = MOD( nsal2, iman ) 127 IF( nsal2 == 0 ) nsal2 = iman 128 IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 129 IF(lwp) WRITE(numout,*) 'last record file used nsal2 ', nsal2 130 131 ! 2.3 Read monthly salinity data Levitus 132 133 #if defined key_orca_lev10 134 if (ln_zps) stop 135 zsal(:,:,:,:) = 0. 136 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 137 CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 50 !!---------------------------------------------------------------------- 51 !! *** ROUTINE dta_sal *** 52 !! 53 !! ** Purpose : Reads monthly salinity data 54 !! 55 !! ** Method : - Read on unit numsdt the monthly salinity data interpo- 56 !! lated onto the model grid. 57 !! - At each time step, a linear interpolation is applied 58 !! between two monthly values. 59 !! 60 !! History : 61 !! ! 91-03 () Original code 62 !! ! 92-07 (M. Imbard) 63 !! 9.0 ! 02-06 (G. Madec) F90: Free form and module 64 !!---------------------------------------------------------------------- 65 66 !! * Arguments 67 INTEGER, INTENT(in) :: kt ! ocean time step 68 69 !! * Local declarations 70 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 71 INTEGER :: imois, iman, i15 , ik ! temporary integers 72 INTEGER :: ierror 73 #if defined key_tradmp 74 INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 75 #endif 76 REAL(wp):: zxy, zl 77 #if defined key_orca_lev10 78 INTEGER :: ikr, ikw, ikt, jjk 79 REAL(wp):: zfac 80 #endif 81 REAL(wp), DIMENSION(jpk) :: zsaldta ! auxiliary array for interpolation 82 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 83 TYPE(FLD_N) :: sn_sal 84 LOGICAL , SAVE :: linit_sal = .FALSE. 85 !!---------------------------------------------------------------------- 86 NAMELIST/namdta_sal/cn_dir,sn_sal 87 88 ! 1. Initialization 89 ! ----------------------- 90 91 IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN 92 93 ! ! set file information 94 cn_dir = './' ! directory in which the model is executed 95 ! ... default values (NB: frequency positive => hours, negative => months) 96 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 97 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 98 sn_sal = FLD_N( 'salinity', -1. , 'vosaline', .false. , .true. , 'monthly' , '' , '' ) 99 100 REWIND ( numnam ) ! ... read in namlist namdta_sal 101 READ( numnam, namdta_sal ) 102 103 IF(lwp) THEN ! control print 104 WRITE(numout,*) 105 WRITE(numout,*) 'dta_sal : Salinity Climatology ' 106 WRITE(numout,*) '~~~~~~~ ' 107 ENDIF 108 ALLOCATE( sf_sal(1), STAT=ierror ) 109 IF( ierror > 0 ) THEN 110 CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' ) ; RETURN 111 ENDIF 112 #if defined key_orca_lev10 113 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta ) ) 114 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 138 115 #else 139 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1) 140 CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2) 141 #endif 142 143 IF(lwp) THEN 144 WRITE(numout,*) 145 WRITE(numout,*) ' read Levitus salinity ok' 146 WRITE(numout,*) 147 ENDIF 148 116 ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk ) ) 117 ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 118 #endif 119 120 ! fill sf_sal with sn_sal and control print 121 CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 122 linit_sal = .TRUE. 123 ENDIF 124 125 126 ! 2. Read monthly file 127 ! ------------------- 128 129 CALL fld_read( kt, 1, sf_sal ) 130 131 IF( lwp .AND. kt==nn_it000 ) THEN 132 WRITE(numout,*) 133 WRITE(numout,*) ' read Levitus salinity ok' 134 WRITE(numout,*) 135 ENDIF 136 149 137 #if defined key_tradmp 150 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 138 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 139 140 ! ! ======================= 141 ! ! ORCA_R2 configuration 142 ! ! ======================= 143 ij0 = 101 ; ij1 = 109 144 ii0 = 141 ; ii1 = 155 145 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 146 DO ji = mi0(ii0), mi1(ii1) 147 sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15 148 sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25 149 sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30 150 sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35 151 END DO 152 END DO 153 154 IF( n_cla == 1 ) THEN 155 ! ! New salinity profile at Gibraltar 156 il0 = 138 ; il1 = 138 157 ij0 = 101 ; ij1 = 102 158 ii0 = 139 ; ii1 = 139 159 DO jl = mi0(il0), mi1(il1) 160 DO jj = mj0(ij0), mj1(ij1) 161 DO ji = mi0(ii0), mi1(ii1) 162 sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 163 END DO 164 END DO 165 END DO 166 ! ! New salinity profile at Bab el Mandeb 167 il0 = 164 ; il1 = 164 168 ij0 = 87 ; ij1 = 88 169 ii0 = 161 ; ii1 = 163 170 DO jl = mi0(il0), mi1(il1) 171 DO jj = mj0(ij0), mj1(ij1) 172 DO ji = mi0(ii0), mi1(ii1) 173 sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 174 END DO 175 END DO 176 END DO 177 ! 178 ENDIF 179 ! 180 ENDIF 181 #endif 182 183 #if defined key_orca_lev10 184 DO jjk = 1, 5 185 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1) 186 ENDDO 187 DO jk = 1, jpk-20,10 188 ikr = INT(jk/10) + 1 189 ikw = (ikr-1) *10 + 1 190 ikt = ikw + 5 191 DO jjk=ikt,ikt+9 192 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 193 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac 194 END DO 195 END DO 196 DO jjk = jpk-5, jpk 197 s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1) 198 END DO 199 ! fill the overlap areas 200 CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0') 201 #else 202 s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:) 203 #endif 204 205 IF( ln_sco ) THEN 206 DO jj = 1, jpj ! interpolation of salinites 207 DO ji = 1, jpi 208 DO jk = 1, jpk 209 zl=fsdept_0(ji,jj,jk) 210 IF(zl < gdept_0(1) ) zsaldta(jk) = s_dta(ji,jj,1 ) 211 IF(zl > gdept_0(jpk)) zsaldta(jk) = s_dta(ji,jj,jpkm1) 212 DO jkk = 1, jpkm1 213 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 214 zsaldta(jk) = s_dta(ji,jj,jkk) & 215 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 216 & *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk)) 217 ENDIF 218 END DO 219 END DO 220 DO jk = 1, jpkm1 221 s_dta(ji,jj,jk) = zsaldta(jk) 222 END DO 223 s_dta(ji,jj,jpk) = 0.0 224 END DO 225 END DO 151 226 152 ! ! ======================= 153 ! ! ORCA_R2 configuration 154 ! ! ======================= 155 ij0 = 101 ; ij1 = 109 156 ii0 = 141 ; ii1 = 155 157 DO jj = mj0(ij0), mj1(ij1) ! Reduced salinity in the Alboran Sea 158 DO ji = mi0(ii0), mi1(ii1) 159 #if defined key_orca_lev10 160 zsal (ji,jj,13:13,:) = zsal (ji,jj,13:13,:) - 0.15 161 zsal (ji,jj,14:15,:) = zsal (ji,jj,14:15,:) - 0.25 162 zsal (ji,jj,16:17,:) = zsal (ji,jj,16:17,:) - 0.30 163 zsal (ji,jj,18:25,:) = zsal (ji,jj,18:25,:) - 0.35 164 #else 165 saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15 166 saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25 167 saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30 168 saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35 169 #endif 170 END DO 171 END DO 172 173 IF( n_cla == 1 ) THEN 174 ! ! New salinity profile at Gibraltar 175 il0 = 138 ; il1 = 138 176 ij0 = 101 ; ij1 = 102 177 ii0 = 139 ; ii1 = 139 178 DO jl = mi0(il0), mi1(il1) 179 DO jj = mj0(ij0), mj1(ij1) 180 DO ji = mi0(ii0), mi1(ii1) 181 #if defined key_orca_lev10 182 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 183 #else 184 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 185 #endif 186 END DO 187 END DO 188 END DO 189 ! ! New salinity profile at Bab el Mandeb 190 il0 = 164 ; il1 = 164 191 ij0 = 87 ; ij1 = 88 192 ii0 = 161 ; ii1 = 163 193 DO jl = mi0(il0), mi1(il1) 194 DO jj = mj0(ij0), mj1(ij1) 195 DO ji = mi0(ii0), mi1(ii1) 196 #if defined key_orca_lev10 197 zsal (ji,jj,:,:) = zsal (jl,jj,:,:) 198 #else 199 saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 200 #endif 201 END DO 202 END DO 203 END DO 204 ! 205 ENDIF 206 ! 207 ENDIF 208 #endif 209 210 #if defined key_orca_lev10 211 ! interpolate from 31 to 301 level the zsal field result in saldta 212 DO jl = 1, 2 213 DO jjk = 1, 5 214 saldta(:,:,jjk,jl) = zsal(:,:,1,jl) 215 ENDDO 216 DO jk = 1, jpk - 20, 10 217 ikr = INT( jk / 10 ) + 1 218 ikw = (ikr-1) * 10 + 1 219 ikt = ikw + 5 220 DO jjk = ikt , ikt + 9 221 zfac = ( gdept_0(jjk) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 222 saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac 223 END DO 224 END DO 225 DO jjk = jpk-5, jpk 226 saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl) 227 END DO 228 ! fill the overlap areas 229 CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0') 230 END DO 231 232 #endif 233 234 IF( ln_sco ) THEN 235 DO jl = 1, 2 236 DO jj = 1, jpj ! interpolation of salinites 237 DO ji = 1, jpi 238 DO jk = 1, jpk 239 zl=fsdept_0(ji,jj,jk) 240 IF(zl < gdept_0(1)) zsaldta(jk,jl) = saldta(ji,jj,1,jl) 241 IF(zl > gdept_0(jpk)) zsaldta(jk,jl) = saldta(ji,jj,jpkm1,jl) 242 DO jkk = 1, jpkm1 243 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 244 zsaldta(jk,jl) = saldta(ji,jj,jkk,jl) & 245 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 246 & *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 247 ENDIF 248 END DO 249 END DO 250 DO jk = 1, jpkm1 251 saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 252 END DO 253 saldta(ji,jj,jpk,jl) = 0.0 254 END DO 255 END DO 256 END DO 257 258 IF(lwp) WRITE(numout,*) 259 IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 260 IF(lwp) WRITE(numout,*) 261 262 ELSE 263 ! ! Mask 264 DO jl = 1, 2 265 saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 266 saldta(:,:,jpk,jl) = 0. 267 IF( ln_zps ) THEN ! z-coord. partial steps 268 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 269 DO ji = 1, jpi 270 ik = mbathy(ji,jj) - 1 271 IF( ik > 2 ) THEN 272 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 273 saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 274 ENDIF 275 END DO 276 END DO 277 ENDIF 278 END DO 279 ENDIF 280 281 282 IF(lwp) THEN 283 WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 284 WRITE(numout,*) 285 WRITE(numout,*) ' Levitus month = ',nsal1,' level = 1' 286 CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 287 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpk/2 288 CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 289 WRITE(numout,*) ' Levitus month = ',nsal1,' level = ',jpkm1 290 CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 291 ENDIF 292 ENDIF 293 294 295 ! 3. At every time step compute salinity data 296 ! ------------------------------------------- 297 298 zxy = FLOAT(nday + 15 - 30*i15)/30. 299 s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 300 301 ! Close the file 302 ! -------------- 303 304 IF( kt == nitend ) CALL iom_close (numsdt) 227 IF( lwp .AND. kt==nn_it000 ) THEN 228 WRITE(numout,*) 229 WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 230 WRITE(numout,*) 231 ENDIF 232 233 ELSE 234 ! ! Mask 235 s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 236 s_dta(:,:,jpk) = 0. 237 IF( ln_zps ) THEN ! z-coord. partial steps 238 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 239 DO ji = 1, jpi 240 ik = mbathy(ji,jj) - 1 241 IF( ik > 2 ) THEN 242 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 243 s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1) 244 ENDIF 245 END DO 246 END DO 247 ENDIF 248 ENDIF 249 250 IF( lwp .AND. kt==nn_it000 ) THEN 251 WRITE(numout,*)' salinity Levitus ' 252 WRITE(numout,*) 253 WRITE(numout,*)' level = 1' 254 CALL prihre(s_dta(:,:,1), jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 255 WRITE(numout,*)' level = ',jpk/2 256 CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 257 WRITE(numout,*) ' level = ',jpkm1 258 CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 259 ENDIF 305 260 306 261 END SUBROUTINE dta_sal -
branches/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DTA/dtatem.F90
r1715 r1951 13 13 USE oce ! ocean dynamics and tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE fldread ! read input fields 15 16 USE in_out_manager ! I/O manager 16 17 USE phycst ! physical constants … … 26 27 !! * Shared module variables 27 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtatem = .TRUE. !: temperature data flag 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 t_dta !: temperature data at given time-step 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: t_dta !: temperature data at given time-step 30 30 31 31 !! * Module variables 32 INTEGER :: & 33 numtdt, & !: logical unit for data temperature 34 ntem1, ntem2 ! first and second record used 35 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 36 temdta ! temperature data at two consecutive times 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tem ! structure of input SST (file informations, fields read) 37 33 38 34 !! * Substitutions … … 73 69 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 74 70 !!---------------------------------------------------------------------- 75 !! * Modules used76 USE iom77 78 71 !! * Arguments 79 72 INTEGER, INTENT( in ) :: kt ! ocean time-step 80 73 81 74 !! * Local declarations 82 INTEGER :: ji, jj, j l, jk, jkk! dummy loop indicies83 INTEGER :: &84 imois, iman, i15 , ik ! temporary integers85 # 86 INTEGER :: &87 il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 88 # endif 89 REAL(wp) :: zxy, zl 90 #if defined key_orca_lev10 91 REAL(wp) , DIMENSION(jpi,jpj,jpkdta,2) :: ztem92 INTEGER :: ikr, ikw, ikt, jjk 93 REAL(wp) :: zfac94 #endif 95 REAL(wp), DIMENSION(jpk,2) :: &96 ztemdta ! auxiliary array for interpolation75 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 76 INTEGER :: imois, iman, i15 , ik ! temporary integers 77 INTEGER :: ierror 78 #if defined key_tradmp 79 INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 80 #endif 81 REAL(wp):: zxy, zl 82 #if defined key_orca_lev10 83 INTEGER :: ikr, ikw, ikt, jjk 84 REAL(wp):: zfac 85 #endif 86 REAL(wp), DIMENSION(jpk) :: ztemdta ! auxiliary array for interpolation 87 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 88 TYPE(FLD_N) :: sn_tem 89 LOGICAL , SAVE :: linit_tem = .FALSE. 97 90 !!---------------------------------------------------------------------- 98 99 ! 0. Initialization 100 ! ----------------- 101 102 iman = INT( raamo ) 103 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 104 i15 = nday / 16 105 imois = nmonth + i15 - 1 106 IF( imois == 0 ) imois = iman 107 108 ! 1. First call kt=nit000 91 NAMELIST/namdta_tem/cn_dir,sn_tem 92 93 ! 1. Initialization 109 94 ! ----------------------- 110 95 111 IF( kt == nit000 ) THEN 112 113 ntem1= 0 ! initializations 114 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 115 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt ) 116 117 ENDIF 118 96 IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 97 98 ! ! set file information 99 cn_dir = './' ! directory in which the model is executed 100 ! ... default values (NB: frequency positive => hours, negative => months) 101 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 102 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 103 sn_tem = FLD_N( 'temperature', -1. , 'votemper', .false. , .true. , 'yearly' , '' , '' ) 104 105 REWIND( numnam ) ! ... read in namlist namdta_tem 106 READ( numnam, namdta_tem ) 107 108 IF(lwp) THEN ! control print 109 WRITE(numout,*) 110 WRITE(numout,*) 'dta_tem : Temperature Climatology ' 111 WRITE(numout,*) '~~~~~~~ ' 112 ENDIF 113 ALLOCATE( sf_tem(1), STAT=ierror ) 114 IF( ierror > 0 ) THEN 115 CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' ) ; RETURN 116 ENDIF 117 118 #if defined key_orca_lev10 119 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta ) ) 120 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 121 #else 122 ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk ) ) 123 ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 124 #endif 125 ! fill sf_tem with sn_tem and control print 126 CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 127 linit_tem = .TRUE. 128 129 ENDIF 119 130 120 131 ! 2. Read monthly file 121 132 ! ------------------- 122 123 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 124 125 ! Calendar computation 126 127 ntem1 = imois ! first file record used 128 ntem2 = ntem1 + 1 ! last file record used 129 ntem1 = MOD( ntem1, iman ) 130 IF( ntem1 == 0 ) ntem1 = iman 131 ntem2 = MOD( ntem2, iman ) 132 IF( ntem2 == 0 ) ntem2 = iman 133 IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 134 IF(lwp) WRITE(numout,*) 'last record file used ntem2 ', ntem2 135 136 ! Read monthly temperature data Levitus 137 138 #if defined key_orca_lev10 139 if (ln_zps) stop 140 ztem(:,:,:,:) = 0. 141 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 142 CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 143 #else 144 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 145 CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 146 #endif 147 148 IF(lwp) WRITE(numout,*) 149 IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 150 IF(lwp) WRITE(numout,*) 133 134 CALL fld_read( kt, 1, sf_tem ) 135 136 IF( lwp .AND. kt==nn_it000 )THEN 137 WRITE(numout,*) 138 WRITE(numout,*) ' read Levitus temperature ok' 139 WRITE(numout,*) 140 ENDIF 151 141 152 142 #if defined key_tradmp 153 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 154 155 ! ! ======================= 156 ! ! ORCA_R2 configuration 157 ! ! ======================= 158 ij0 = 101 ; ij1 = 109 159 ii0 = 141 ; ii1 = 155 160 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 161 DO ji = mi0(ii0), mi1(ii1) 162 #if defined key_orca_lev10 163 ztem( ji,jj, 13:13 ,:) = ztem (ji,jj, 13:13 ,:) - 0.20 164 ztem (ji,jj, 14:15 ,:) = ztem (ji,jj, 14:15 ,:) - 0.35 165 ztem (ji,jj, 16:25 ,:) = ztem (ji,jj, 16:25 ,:) - 0.40 143 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 144 145 ! ! ======================= 146 ! ! ORCA_R2 configuration 147 ! ! ======================= 148 ij0 = 101 ; ij1 = 109 149 ii0 = 141 ; ii1 = 155 150 DO jj = mj0(ij0), mj1(ij1) ! Reduced temperature in the Alboran Sea 151 DO ji = mi0(ii0), mi1(ii1) 152 sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 153 sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35 154 sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 155 END DO 156 END DO 157 158 IF( n_cla == 1 ) THEN 159 ! ! New temperature profile at Gibraltar 160 il0 = 138 ; il1 = 138 161 ij0 = 101 ; ij1 = 102 162 ii0 = 139 ; ii1 = 139 163 DO jl = mi0(il0), mi1(il1) 164 DO jj = mj0(ij0), mj1(ij1) 165 DO ji = mi0(ii0), mi1(ii1) 166 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 167 END DO 168 END DO 169 END DO 170 ! ! New temperature profile at Bab el Mandeb 171 il0 = 164 ; il1 = 164 172 ij0 = 87 ; ij1 = 88 173 ii0 = 161 ; ii1 = 163 174 DO jl = mi0(il0), mi1(il1) 175 DO jj = mj0(ij0), mj1(ij1) 176 DO ji = mi0(ii0), mi1(ii1) 177 sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 178 END DO 179 END DO 180 END DO 181 ! 182 ELSE 183 ! ! Reduced temperature at Red Sea 184 ij0 = 87 ; ij1 = 96 185 ii0 = 148 ; ii1 = 160 186 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 ) = 7.0 187 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 188 sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 189 ENDIF 190 ! 191 ENDIF 192 #endif 193 194 #if defined key_orca_lev10 195 DO jjk = 1, 5 196 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 197 END DO 198 DO jk = 1, jpk-20,10 199 ik = jk+5 200 ikr = INT(jk/10) + 1 201 ikw = (ikr-1) *10 + 1 202 ikt = ikw + 5 203 DO jjk=ikt,ikt+9 204 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 205 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 206 END DO 207 END DO 208 DO jjk = jpk-5, jpk 209 t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 210 END DO 211 ! fill the overlap areas 212 CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 166 213 #else 167 temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 168 temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 169 temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 170 #endif 171 END DO 172 END DO 173 174 IF( n_cla == 1 ) THEN 175 ! ! New temperature profile at Gibraltar 176 il0 = 138 ; il1 = 138 177 ij0 = 101 ; ij1 = 102 178 ii0 = 139 ; ii1 = 139 179 DO jl = mi0(il0), mi1(il1) 180 DO jj = mj0(ij0), mj1(ij1) 181 DO ji = mi0(ii0), mi1(ii1) 182 #if defined key_orca_lev10 183 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 184 #else 185 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 186 #endif 187 END DO 214 t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:) 215 #endif 216 217 IF( ln_sco ) THEN 218 DO jj = 1, jpj ! interpolation of temperatures 219 DO ji = 1, jpi 220 DO jk = 1, jpk 221 zl=fsdept_0(ji,jj,jk) 222 IF(zl < gdept_0(1)) ztemdta(jk) = t_dta(ji,jj,1) 223 IF(zl > gdept_0(jpk)) ztemdta(jk) = t_dta(ji,jj,jpkm1) 224 DO jkk = 1, jpkm1 225 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 226 ztemdta(jk) = t_dta(ji,jj,jkk) & 227 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 228 & * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 229 ENDIF 188 230 END DO 189 231 END DO 190 ! ! New temperature profile at Bab el Mandeb 191 il0 = 164 ; il1 = 164 192 ij0 = 87 ; ij1 = 88 193 ii0 = 161 ; ii1 = 163 194 DO jl = mi0(il0), mi1(il1) 195 DO jj = mj0(ij0), mj1(ij1) 196 DO ji = mi0(ii0), mi1(ii1) 197 #if defined key_orca_lev10 198 ztem (ji,jj,:,:) = ztem (jl,jj,:,:) 199 #else 200 temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 201 #endif 202 END DO 203 END DO 204 END DO 205 ! 206 ELSE 207 ! ! Reduced temperature at Red Sea 208 ij0 = 87 ; ij1 = 96 209 ii0 = 148 ; ii1 = 160 210 #if defined key_orca_lev10 211 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 212 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 213 ztem ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 214 #else 215 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 4:10 , : ) = 7.0 216 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5 217 temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 218 #endif 219 ENDIF 220 ! 221 ENDIF 222 #endif 223 224 #if defined key_orca_lev10 225 ! interpolate from 31 to 301 level the ztem field result in temdta 226 DO jl = 1, 2 227 DO jjk = 1, 5 228 temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 229 END DO 230 DO jk = 1, jpk-20,10 231 ik = jk+5 232 ikr = INT(jk/10) + 1 233 ikw = (ikr-1) *10 + 1 234 ikt = ikw + 5 235 DO jjk=ikt,ikt+9 236 zfac = ( gdept_0(jjk ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 237 temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 238 END DO 239 END DO 240 DO jjk = jpk-5, jpk 241 temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 242 END DO 243 ! fill the overlap areas 244 CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 245 END DO 246 #endif 247 248 IF( ln_sco ) THEN 249 DO jl = 1, 2 250 DO jj = 1, jpj ! interpolation of temperatures 251 DO ji = 1, jpi 252 DO jk = 1, jpk 253 zl=fsdept_0(ji,jj,jk) 254 IF(zl < gdept_0(1)) ztemdta(jk,jl) = temdta(ji,jj,1,jl) 255 IF(zl > gdept_0(jpk)) ztemdta(jk,jl) = temdta(ji,jj,jpkm1,jl) 256 DO jkk = 1, jpkm1 257 IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 258 ztemdta(jk,jl) = temdta(ji,jj,jkk,jl) & 259 & + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk)) & 260 & *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 261 ENDIF 262 END DO 263 END DO 264 DO jk = 1, jpkm1 265 temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 266 END DO 267 temdta(ji,jj,jpk,jl) = 0.0 268 END DO 269 END DO 270 END DO 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 274 IF(lwp) WRITE(numout,*) 275 276 ELSE 277 278 ! ! Mask 279 DO jl = 1, 2 280 temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 281 temdta(:,:,jpk,jl) = 0. 282 IF( ln_zps ) THEN ! z-coord. with partial steps 283 DO jj = 1, jpj ! interpolation of temperature at the last level 284 DO ji = 1, jpi 285 ik = mbathy(ji,jj) - 1 286 IF( ik > 2 ) THEN 287 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 288 temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 289 ENDIF 290 END DO 291 END DO 292 ENDIF 293 END DO 294 295 ENDIF 296 297 IF(lwp) THEN 298 WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 232 DO jk = 1, jpkm1 233 t_dta(ji,jj,jk) = ztemdta(jk) 234 END DO 235 t_dta(ji,jj,jpk) = 0.0 236 END DO 237 END DO 238 239 IF( lwp .AND. kt==nn_it000 )THEN 299 240 WRITE(numout,*) 300 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = 1' 301 CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 302 WRITE(numout,*) ' Levitus month = ', ntem1, ' level = ', jpk/2 303 CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 304 WRITE(numout,*) ' Levitus month = ',ntem1,' level = ', jpkm1 305 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 306 ENDIF 307 ENDIF 308 309 310 ! 2. At every time step compute temperature data 311 ! ---------------------------------------------- 312 313 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 314 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 315 316 ! Close the file 317 ! -------------- 318 319 IF( kt == nitend ) CALL iom_close (numtdt) 320 321 END SUBROUTINE dta_tem 241 WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 242 WRITE(numout,*) 243 ENDIF 244 245 ELSE 246 ! ! Mask 247 t_dta(:,:,: ) = t_dta(:,:,:) * tmask(:,:,:) 248 t_dta(:,:,jpk) = 0. 249 IF( ln_zps ) THEN ! z-coord. with partial steps 250 DO jj = 1, jpj ! interpolation of temperature at the last level 251 DO ji = 1, jpi 252 ik = mbathy(ji,jj) - 1 253 IF( ik > 2 ) THEN 254 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 255 t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 256 ENDIF 257 END DO 258 END DO 259 ENDIF 260 261 ENDIF 262 263 IF( lwp .AND. kt==nn_it000 ) THEN 264 WRITE(numout,*) ' temperature Levitus ' 265 WRITE(numout,*) 266 WRITE(numout,*)' level = 1' 267 CALL prihre( t_dta(:,:,1 ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 268 WRITE(numout,*)' level = ', jpk/2 269 CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 270 WRITE(numout,*)' level = ', jpkm1 271 CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 272 ENDIF 273 274 END SUBROUTINE dta_tem 322 275 323 276 #else
Note: See TracChangeset
for help on using the changeset viewer.
