Changeset 6466 for branches/NERC
- Timestamp:
- 2016-04-11T17:54:56+02:00 (8 years ago)
- Location:
- branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 4 edited
-
IDTRA/trcsms_idtra.F90 (modified) (3 diffs)
-
MEDUSA/sms_medusa.F90 (modified) (2 diffs)
-
MEDUSA/trcbio_medusa.F90 (modified) (1 diff)
-
MEDUSA/trcsed_medusa.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90
r6295 r6466 74 74 !! 75 75 !!---------------------------------------------------------------------- 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 77 !! 78 INTEGER :: ji, jj, jn, jl, jk 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 77 !! 78 INTEGER :: ji, jj, jn, jl, jk 79 REAL(wp) :: rlx !! relaxation time (1 day) 79 80 !!---------------------------------------------------------------------- 80 81 ! … … 92 93 93 94 ! 94 inv_idtra(:,:,:) = 0.0 !! init the inventory 95 qtr_idtra(:,:,:) = 0.0 !! init the air-sea flux 95 rlx = 1/(60 * 60 * 24) !! relaxation time (1 day) 96 inv_idtra(:,:,:) = 0.0 !! init the inventory 97 qtr_idtra(:,:,:) = 0.0 !! init the air-sea flux 96 98 DO jl = 1, jp_idtra 97 99 jn = jp_idtra0 + jl - 1 … … 103 105 104 106 !! First, a crude version. will be much inproved later. 105 qtr_idtra(ji,jj,jl) = (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) * &107 qtr_idtra(ji,jj,jl) = rlx * (1. - trb(ji,jj,1,jn)) * tmask(ji,jj,1) * & 106 108 fse3t(ji,jj,1) / rdt !! Air-sea Flux 109 110 !! DEBUG-TEST : Set flux equal to 0, see if it induces the pb we see in the MED 111 !! qtr_idtra(ji,jj,jl) = 0.0 107 112 ENDDO 108 113 ENDDO -
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
r5841 r6466 250 250 !! 251 251 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust parameter 1 252 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo !: dust parameter 2253 252 254 253 !!---------------------------------------------------------------------- … … 473 472 !* 2D fields of miscellaneous parameters 474 473 ALLOCATE( ocal_ccd(jpi,jpj) , dust(jpi,jpj) , & 475 & dustmo(jpi,jpj,2) , riv_n(jpi,jpj), &474 & riv_n(jpi,jpj) , & 476 475 & riv_si(jpi,jpj) , riv_c(jpi,jpj) , & 477 476 & riv_alk(jpi,jpj) , friver_dep(jpk,jpk) , STAT=ierr(5) ) -
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r6288 r6466 1312 1312 if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 1313 1313 IF (lwp) write (numout,*) '------------------------------' 1314 IF (lwp) write (numout,*) 'dustmo(1) = ', dustmo(ji,jj,1)1315 IF (lwp) write (numout,*) 'dustmo(2) = ', dustmo(ji,jj,2)1316 1314 IF (lwp) write (numout,*) 'dust = ', dust(ji,jj) 1317 1315 endif -
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
r6173 r6466 25 25 !! USE trc_nam_dia ! JPALM 13-11-2015 -- if iom_use for diag 26 26 !! USE trc_nam_iom_medusa ! JPALM 13-11-2015 -- if iom_use for diag 27 27 USE fldread ! time interpolation 28 28 USE lbclnk 29 29 USE prtctl_trc ! Print control for debbuging … … 41 41 42 42 !! AXY (10/02/09) 43 LOGICAL, PUBLIC :: & 44 bdustfer = .TRUE. 43 LOGICAL, PUBLIC :: bdustfer !: boolean for dust input from the atmosphere 45 44 REAL(wp), PUBLIC :: & 46 45 sedfeinput = 1.e-9_wp , & 47 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 48 51 INTEGER :: & 49 52 numdust, & 50 53 nflx1, nflx2, & 51 54 nflx11, nflx12 55 56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust 57 58 52 59 !!* Substitution 53 60 # include "domzgr_substitute.h90" … … 132 139 133 140 !! AXY (10/02/09) 134 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 135 154 !! 136 155 zirondep(:,:,:) = 0.e0 !! Initialisation of deposition variables … … 262 281 263 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. 264 288 SUBROUTINE trc_sed_medusa_sbc(kt) 265 289 … … 267 291 !! *** ROUTINE trc_sed_medusa_sbc *** 268 292 !! 269 !! ** Purpose : Read and interpolate the external sources of 270 !! nutrients 271 !! 272 !! ** Method : Read the files and interpolate the appropriate variables 273 !! 274 !! ** 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 275 302 !! 276 303 !!---------------------------------------------------------------------- 277 304 !! * arguments 278 305 INTEGER, INTENT( in ) :: kt ! ocean time step 279 280 !! * Local declarations 281 INTEGER :: & 282 imois, imois2, & ! temporary integers 283 i15 , iman ! " " 284 REAL(wp) :: & 285 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 286 320 287 321 !!--------------------------------------------------------------------- 288 IF (bdustfer) THEN 289 !! Initialization 290 !! -------------- 291 !! 292 i15 = nday / 16 293 iman = INT( raamo ) 294 imois = nmonth + i15 - 1 295 IF( imois == 0 ) imois = iman 296 imois2 = nmonth 297 298 !! 1. first call kt=nittrc000 299 !! ----------------------- 300 !! 301 IF (kt == nittrc000) THEN 302 ! initializations 303 nflx1 = 0 304 nflx11 = 0 305 ! open the file 306 IF(lwp) THEN 307 WRITE(numout,*) ' ' 308 WRITE(numout,*) ' **** Routine trc_sed_medusa_sbc' 309 ENDIF 310 CALL iom_open ( 'dust.orca.nc', numdust ) 311 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc opened' 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) 312 369 ENDIF 313 314 !! Read monthly file 315 !! ---------------- 316 !! 317 IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 318 319 !! Calendar computation 320 !! 321 !! nflx1 number of the first file record used in the simulation 322 !! nflx2 number of the last file record 323 !! 324 nflx1 = imois 325 nflx2 = nflx1+1 326 nflx1 = MOD( nflx1, iman ) 327 nflx2 = MOD( nflx2, iman ) 328 IF( nflx1 == 0 ) nflx1 = iman 329 IF( nflx2 == 0 ) nflx2 = iman 330 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: first record file used nflx1 ',nflx1 331 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: last record file used nflx2 ',nflx2 332 333 !! Read monthly fluxes data 334 !! 335 !! humidity 336 !! 337 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 338 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 339 340 IF(lwp .AND. nitend-nit000 <= 100 ) THEN 341 WRITE(numout,*) 342 WRITE(numout,*) ' read clio flx ok' 343 WRITE(numout,*) 344 WRITE(numout,*) 345 WRITE(numout,*) 'Clio month: ',nflx1,' field: dust' 346 CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 347 ENDIF 348 349 ENDIF 350 351 !! 3. at every time step interpolation of fluxes 352 !! --------------------------------------------- 353 !! 354 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 355 dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 356 357 IF( kt == nitend ) THEN 358 CALL iom_close (numdust) 359 IF(lwp) WRITE(numout,*) 'trc_sed_medusa_sbc: dust.orca.nc closed' 360 ENDIF 361 ELSE 370 ! 371 CALL fld_read( kt, 1, sf_dust ) 372 dust(:,:) = sf_dust(1)%fnow(:,:,1) 373 ! 374 ELSE 362 375 dust(:,:) = 0.0 363 ENDIF 376 END IF 377 ! 378 IF( nn_timing == 1 ) CALL timing_stop('trc_sed_medusa_sbc') 379 ! 364 380 END SUBROUTINE trc_sed_medusa_sbc 365 381
Note: See TracChangeset
for help on using the changeset viewer.
