New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6466 for branches/NERC – NEMO

Changeset 6466 for branches/NERC


Ignore:
Timestamp:
2016-04-11T17:54:56+02:00 (8 years ago)
Author:
jpalmier
Message:

JPALM -- 11-04-2016 -- add dust deposition input through namelist

-- relax time to IDTRA surface flux

Location:
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90

    r6295 r6466  
    7474      !!               
    7575      !!---------------------------------------------------------------------- 
    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) 
    7980      !!---------------------------------------------------------------------- 
    8081      ! 
     
    9293 
    9394         ! 
    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 
    9698      DO jl = 1, jp_idtra 
    9799         jn = jp_idtra0 + jl - 1 
     
    103105 
    104106         !! 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) *   &  
    106108                                  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 
    107112           ENDDO 
    108113         ENDDO 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90

    r5841 r6466  
    250250!! 
    251251   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust      !: dust parameter 1 
    252    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dustmo    !: dust parameter 2 
    253252 
    254253!!---------------------------------------------------------------------- 
     
    473472      !* 2D fields of miscellaneous parameters 
    474473      ALLOCATE( ocal_ccd(jpi,jpj)    , dust(jpi,jpj)        ,       & 
    475          &      dustmo(jpi,jpj,2)    , riv_n(jpi,jpj)       ,       & 
     474         &      riv_n(jpi,jpj)                              ,       & 
    476475         &      riv_si(jpi,jpj)      , riv_c(jpi,jpj)       ,       & 
    477476         &      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  
    13121312               if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 
    13131313                  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) 
    13161314                  IF (lwp) write (numout,*) 'dust      = ', dust(ji,jj) 
    13171315               endif 
  • branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90

    r6173 r6466  
    2525   !! USE trc_nam_dia         ! JPALM 13-11-2015 -- if iom_use for diag 
    2626   !! USE trc_nam_iom_medusa  ! JPALM 13-11-2015 -- if iom_use for diag 
    27  
     27   USE fldread         !  time interpolation 
    2828   USE lbclnk 
    2929   USE prtctl_trc      ! Print control for debbuging 
     
    4141 
    4242   !! AXY (10/02/09) 
    43    LOGICAL, PUBLIC ::                  & 
    44       bdustfer = .TRUE. 
     43   LOGICAL, PUBLIC  ::   bdustfer  !: boolean for dust input from the atmosphere 
    4544   REAL(wp), PUBLIC ::                 & 
    4645      sedfeinput = 1.e-9_wp  ,         & 
    4746      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 
    4851   INTEGER ::                          & 
    4952      numdust,                         & 
    5053      nflx1,  nflx2,                   & 
    5154      nflx11, nflx12 
     55    
     56   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust 
     57 
     58    
    5259   !!* Substitution 
    5360#  include "domzgr_substitute.h90" 
     
    132139 
    133140      !! 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            
    135154      !! 
    136155      zirondep(:,:,:) = 0.e0     !! Initialisation of deposition variables 
     
    262281 
    263282   !! 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.       
    264288   SUBROUTINE trc_sed_medusa_sbc(kt) 
    265289 
     
    267291      !!                  ***  ROUTINE trc_sed_medusa_sbc  *** 
    268292      !! 
    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 
    275302      !! 
    276303      !!---------------------------------------------------------------------- 
    277304      !! * arguments 
    278305      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  
    286320 
    287321      !!--------------------------------------------------------------------- 
    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) 
     328901   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 ) 
     332902   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) 
    312369         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 
    362375         dust(:,:) = 0.0 
    363       ENDIF 
     376      END IF 
     377      ! 
     378      IF( nn_timing == 1 )  CALL timing_stop('trc_sed_medusa_sbc') 
     379      ! 
    364380   END SUBROUTINE trc_sed_medusa_sbc 
    365381 
Note: See TracChangeset for help on using the changeset viewer.