Changeset 6639 for branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
- Timestamp:
- 2016-05-27T14:58:40+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_RH_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
r5726 r6639 23 23 !! AXY (10/02/09) 24 24 USE iom 25 25 !! USE trc_nam_dia ! JPALM 13-11-2015 -- if iom_use for diag 26 !! USE trc_nam_iom_medusa ! JPALM 13-11-2015 -- if iom_use for diag 27 USE fldread ! time interpolation 26 28 USE lbclnk 27 29 USE prtctl_trc ! Print control for debbuging … … 39 41 40 42 !! AXY (10/02/09) 41 LOGICAL, PUBLIC :: & 42 bdustfer = .TRUE. 43 LOGICAL, PUBLIC :: bdustfer !: boolean for dust input from the atmosphere 43 44 REAL(wp), PUBLIC :: & 44 45 sedfeinput = 1.e-9_wp , & 45 46 dustsolub = 0.014_wp 47 48 INTEGER , PARAMETER :: nbtimes = 365 !: maximum number of times record in a file 49 INTEGER :: ntimes_dust ! number of time steps in a file 50 46 51 INTEGER :: & 47 52 numdust, & 48 53 nflx1, nflx2, & 49 54 nflx11, nflx12 55 56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust 57 58 50 59 !!* Substitution 51 60 # include "domzgr_substitute.h90" … … 90 99 91 100 CHARACTER (len=25) :: charout 101 102 !! JPALM - 26-11-2015 -add iom_use for diagnostic 103 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d 92 104 !!--------------------------------------------------------------------- 93 105 !! 106 IF( lk_iomput) THEN 107 IF( med_diag%DSED%dgsave ) THEN 108 CALL wrk_alloc( jpi, jpj, zw2d ) 109 zw2d(:,:) = 0.0 !! 110 ENDIF 111 ENDIF 112 94 113 !! AXY (10/02/09) 95 114 jnt = 1 … … 120 139 121 140 !! AXY (10/02/09) 122 IF( (jnt == 1) .and. (bdustfer) ) CALL trc_sed_medusa_sbc( kt ) 141 !!IF( (jnt == 1) .and. (bdustfer) ) CALL trc_sed_medusa_sbc( kt ) 142 !! JPALM -- 31-03-2016 -- rewrite trc_sed_medusa_sbc. 143 !! IF (kt == nittrc000 ) CALL trc_sed_medusa_sbc 144 IF( bdustfer ) THEN 145 IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_dust > 1 ) ) THEN 146 CALL fld_read( kt, 1, sf_dust ) 147 dust(:,:) = sf_dust(1)%fnow(:,:,1) 148 ENDIF 149 ELSE 150 dust(:,:) = 0.0 151 ENDIF 152 !! 153 123 154 !! 124 155 zirondep(:,:,:) = 0.e0 !! Initialisation of deposition variables … … 165 196 trbio(ji,jj,jk,8) = ztra 166 197 # endif 167 IF( ln_diatrc ) & 168 & trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 198 IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 199 IF( med_diag%DSED%dgsave ) THEN 200 zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400 201 ENDIF 202 ELSE IF( ln_diatrc ) THEN 203 trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400 204 ENDIF 205 169 206 END DO 170 207 END DO … … 175 212 # endif 176 213 IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d 177 # if defined key_iomput 178 CALL iom_put( "DSED",trc2d(:,:,8) ) 179 # endif 180 214 !! 215 IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 216 IF( med_diag%DSED%dgsave ) THEN 217 CALL iom_put( "DSED" , zw2d) 218 CALL wrk_dealloc( jpi, jpj, zw2d ) 219 ENDIF 220 ELSE IF (lk_iomput .AND. ln_diatrc) THEN 221 CALL iom_put( "DSED",trc2d(:,:,8) ) 222 ENDIF 223 !! 181 224 # if defined key_roam 182 225 … … 238 281 239 282 !! AXY (10/02/09) 283 !! JPALM -- 31-03-2016 -- Completely change trc_sed_medusa_sbc. 284 !! -- We now need to read dust file through a namelist. 285 !! To be able to use time varying dust depositions from 286 !! -- copy and adapt the PISCES p4z_sbc_ini subroutine 287 !! -- Only use the dust related part. 240 288 SUBROUTINE trc_sed_medusa_sbc(kt) 241 289 … … 243 291 !! *** ROUTINE trc_sed_medusa_sbc *** 244 292 !! 245 !! ** Purpose : Read and interpolate the external sources of 246 !! nutrients 247 !! 248 !! ** Method : Read the files and interpolate the appropriate variables 249 !! 250 !! ** input : external netcdf files 293 !! ** Purpose : Read and dust namelist and files. 294 !! The interpolation is done in trc_sed through 295 !! "CALL fld_read( kt, 1, sf_dust )" 296 !! 297 !! ** Method : Read the sbc namelist, and the adapted dust file, if required 298 !! called at the first timestep (nittrc000) 299 !! 300 !! ** input : -- namelist sbc ref and cfg 301 !! -- external netcdf files 251 302 !! 252 303 !!---------------------------------------------------------------------- 253 304 !! * arguments 254 305 INTEGER, INTENT( in ) :: kt ! ocean time step 255 256 !! * Local declarations 257 INTEGER :: & 258 imois, imois2, & ! temporary integers 259 i15 , iman ! " " 260 REAL(wp) :: & 261 zxy ! " " 306 INTEGER :: ji, jj, jk, jm, ifpr 307 INTEGER :: ii0, ii1, ij0, ij1 308 INTEGER :: numdust 309 INTEGER :: ierr 310 INTEGER :: ios ! Local integer output status for namelist read 311 INTEGER :: isrow ! index for ORCA1 starting row 312 REAL(wp) :: ztimes_dust 313 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 314 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust 315 ! 316 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 317 TYPE(FLD_N) :: sn_dust ! informations about the fields to be read 318 ! 319 NAMELIST/nammedsbc/cn_dir, sn_dust, bdustfer 262 320 263 321 !!--------------------------------------------------------------------- 264 265 !! Initialization 266 !! -------------- 267 !! 268 i15 = nday / 16 269 iman = INT( raamo ) 270 imois = nmonth + i15 - 1 271 IF( imois == 0 ) imois = iman 272 imois2 = nmonth 273 274 !! 1. first call kt=nittrc000 275 !! ----------------------- 276 !! 277 IF( kt == nittrc000 ) THEN 278 ! initializations 279 nflx1 = 0 280 nflx11 = 0 281 ! open the file 282 IF(lwp) THEN 283 WRITE(numout,*) ' ' 284 WRITE(numout,*) ' **** Routine trc_sed_medusa_sbc' 322 ! 323 IF( nn_timing == 1 ) CALL timing_start('trc_sed_medusa_sbc') 324 ! 325 ! !* set file information 326 REWIND( numnatp_ref ) ! Namelist nammedsbc in reference namelist : MEDUSA external sources of Dust 327 READ ( numnatp_ref, nammedsbc, IOSTAT = ios, ERR = 901) 328 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in reference namelist', lwp ) 329 330 REWIND( numnatp_cfg ) ! Namelist nammedsbc in configuration namelist : MEDUSA external sources of Dust 331 READ ( numnatp_cfg, nammedsbc, IOSTAT = ios, ERR = 902 ) 332 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammedsbc in configuration namelist', lwp ) 333 IF(lwm) WRITE ( numonp, nammedsbc ) 334 335 IF(lwp) THEN 336 WRITE(numout,*) ' ' 337 WRITE(numout,*) ' namelist : nammedsbc ' 338 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 339 WRITE(numout,*) ' dust input from the atmosphere bdustfer = ', bdustfer 340 END IF 341 342 ! dust input from the atmosphere 343 ! ------------------------------ 344 IF( bdustfer ) THEN 345 ! 346 IF(lwp) WRITE(numout,*) ' initialize dust input from atmosphere ' 347 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 348 ! 349 !! already allocated in sms_medusa 350 !!ALLOCATE( dust(jpi,jpj) ) ! allocation 351 ! 352 ALLOCATE( sf_dust(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst 353 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'trc_sed_medusa_sbc: unable to allocate sf_dust structure' ) 354 ! 355 CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'trc_sed_medusa_sbc', 'Atmospheric dust deposition', 'nammedsed' ) 356 ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1) ) 357 IF( sn_dust%ln_tint ) ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 358 ! 359 IF( Agrif_Root() ) THEN ! Only on the master grid 360 ! Get total input dust ; need to compute total atmospheric supply of Si in a year 361 CALL iom_open ( TRIM( sn_dust%clname ) , numdust ) 362 CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust) ! get number of record in file 363 ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 364 DO jm = 1, ntimes_dust 365 CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 366 END DO 367 CALL iom_close( numdust ) 368 DEALLOCATE( zdust) 285 369 ENDIF 286 CALL iom_open ( 'dust.orca.nc', numdust ) 287 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc opened' 288 ENDIF 289 290 !! Read monthly file 291 !! ---------------- 292 !! 293 IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 294 295 !! Calendar computation 296 !! 297 !! nflx1 number of the first file record used in the simulation 298 !! nflx2 number of the last file record 299 !! 300 nflx1 = imois 301 nflx2 = nflx1+1 302 nflx1 = MOD( nflx1, iman ) 303 nflx2 = MOD( nflx2, iman ) 304 IF( nflx1 == 0 ) nflx1 = iman 305 IF( nflx2 == 0 ) nflx2 = iman 306 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: first record file used nflx1 ',nflx1 307 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: last record file used nflx2 ',nflx2 308 309 !! Read monthly fluxes data 310 !! 311 !! humidity 312 !! 313 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 314 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 315 316 IF(lwp .AND. nitend-nit000 <= 100 ) THEN 317 WRITE(numout,*) 318 WRITE(numout,*) ' read clio flx ok' 319 WRITE(numout,*) 320 WRITE(numout,*) 321 WRITE(numout,*) 'Clio month: ',nflx1,' field: dust' 322 CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 323 ENDIF 324 325 ENDIF 326 327 !! 3. at every time step interpolation of fluxes 328 !! --------------------------------------------- 329 !! 330 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 331 dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 332 333 IF( kt == nitend ) THEN 334 CALL iom_close (numdust) 335 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc closed' 336 ENDIF 337 370 ! 371 CALL fld_read( kt, 1, sf_dust ) 372 dust(:,:) = sf_dust(1)%fnow(:,:,1) 373 ! 374 ELSE 375 dust(:,:) = 0.0 376 END IF 377 ! 378 IF( nn_timing == 1 ) CALL timing_stop('trc_sed_medusa_sbc') 379 ! 338 380 END SUBROUTINE trc_sed_medusa_sbc 339 381
Note: See TracChangeset
for help on using the changeset viewer.
