Changeset 4011


Ignore:
Timestamp:
2013-09-04T18:48:29+02:00 (8 years ago)
Author:
vichi
Message:

Make a generic interface for trcdta when using other BGCM

This change introduces a more general trcdta structure that
is not strictly dependent on the number of tracers defined
in PISCES. The loop on the number of tracers is moved outside
trcdta and the tracer info and array is passed as an argument.
This allows to use trcdta as a library subroutine by the BFM and
other models.
NOTE: it must be tested throughly with all the PISCES configurations

This commit also updates the GYRE_BFM configuration and corrects
some minor missing cpp keys and real type definitions

Location:
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM
Files:
3 deleted
8 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm

    r3695 r4011  
    1  bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 
     1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE_BFM/README

    r3813 r4011  
    3838(ex: export NEMODIR=path/to/nemo) 
    3939 
    40 Go to the $BFMDIR/build/Configurations/GYRE_BFM directory and read  
     40Go to the $BFMDIR/build/configurations/GYRE_BFM directory and read  
    4141carefully the README file. 
    4242Altrenatively, execute 
     
    4848 
    4949Once the BFM code has been generated the first time, the code can be  
    50 rebuilt with the following command: 
     50also rebuilt with the standard NEMO command: 
    5151./makenemo -n GYRE_BFM -m ARCHFILE -e $BFMDIR/src/nemo  
    5252 
     
    5656The distributed standard test case is GYRE_BFM, a version of GYRE 
    5757with a full-blown BFM. It is a demnstration simulation and it is not 
    58 meant to produce any published result. The namelists for the BFM are  
    59 not distributed with NEMO but are generated directly by the BFM, in 
    60 directory $BFMDIR/run/GYRE_BFM. The user can either copy the content 
    61 of $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 in this directory or the 
    62 other way around. GYRE_BFM runs with analytical input data only. 
     58meant to produce any published result.  
     59GYRE_BFM runs with analytical input data only. 
     60The namelists for the BFM are not distributed with NEMO but are  
     61generated directly by the BFM, in directory $BFMDIR/run/gyre_bfm.  
     62The generation of the BFM namelist also copy the required NEMO 
     63namelist and namelist_top files to this directory.  
     64This is why there are no namelist files found in the standard  
     65run directory $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00  
     66If a user prefers to work in that directory than she has to 
     67copy the generated namelists there  
    6368 
    6469----------------------------------------------------------------------- 
    6570Other examples 
    6671----------------------------------------------------------------------- 
    67 Other couplings with NEMO are available in $BFMDIR/build/Configurations. 
     72Other couplings with NEMO are available in $BFMDIR/build/configurations. 
    6873Please refer to the README file in each directory for more information. 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm

    r3695 r4011  
    1 bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_my_trc key_mpp_mpi key_iomput 
     1bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_my_trc key_mpp_mpi key_iomput key_nosignedzero 
    22inc $BFMDIR/src/nemo/bfm.fcm 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r3294 r4011  
    104104         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    105105         ! 
    106          rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
     106         rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
    107107      ENDIF 
    108108 
    109109      ! Update after tracer on domain lateral boundaries 
    110110      !  
    111       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign) 
    112       CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
     111      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp )      ! local domain boundaries  (T-point, unchanged sign) 
     112      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 
    113113      ! 
    114114#if defined key_obc  
     
    124124      ! set time step size (Euler/Leapfrog) 
    125125      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler) 
    126       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
     126      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2._wp* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
    127127      ENDIF 
    128128 
     
    155155      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    156156         DO jk = 1, jpkm1 
    157             zfact = 1.e0 / r2dtra(jk)              
     157            zfact = 1.e0_wp / r2dtra(jk)              
    158158            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    159159            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/OPA_SRC/step.F90

    r3985 r4011  
    183183                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero 
    184184 
     185!write(numout,*) "MAV kt",kstp 
     186!write(numout,'(a5,3(1x,f21.18))') "INIn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     187!write(numout,'(a5,3(1x,f21.18))') "INIa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    185188      IF(  ln_asmiau .AND. & 
    186189         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment 
     
    192195      IF( lk_bdy         )   CALL bdy_tra_dmp( kstp )       ! bdy damping trends 
    193196                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
     197!write(numout,'(a5,3(1x,f21.18))') "ADVn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     198!write(numout,'(a5,3(1x,f21.18))') "ADVa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    194199      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    195200                             CALL tra_ldf    ( kstp )       ! lateral mixing 
     201!write(numout,'(a5,3(1x,f21.18))') "LDFn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     202!write(numout,'(a5,3(1x,f21.18))') "LDFa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    196203#if defined key_agrif 
    197204      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    198205#endif 
    199206                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
     207!do jk=1,jpk 
     208!write(numout,'(a5,3(1x,f21.18))') "ZDFn:",tsn(5,10,jk,jp_tem),tsn(5,10,jk,jp_sal),tmask(5,10,jk) 
     209!write(numout,'(a5,3(1x,f21.18))') "ZDFa:",tsa(5,10,jk,jp_tem),tsa(5,10,jk,jp_sal),ssha(5,10) 
     210!end do 
    200211 
    201212      IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos) 
     
    210221         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    211222            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
     223!write(numout,'(a5,3(1x,f21.18))') "ZPSn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 
     224!write(numout,'(a5,3(1x,f21.18))') "ZPSa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    212225         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection 
    213226                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
     227!write(numout,'(a5,3(1x,f21.18))') "NXTn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(25,11) 
     228!write(numout,'(a5,3(1x,f21.18))') "NXTa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 
    214229      ENDIF 
    215230 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r3882 r4011  
    8585      CHARACTER (len=22) :: charout 
    8686      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
    87       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
     87      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
    8888      !!---------------------------------------------------------------------- 
    8989      ! 
     
    9898      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    9999         ! 
    100          CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
    101          CALL trc_dta( kt, ztrcdta )   ! read tracer data at nit000 
     100         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    102101         !                                                          ! =========== 
    103102         DO jn = 1, jptra                                           ! tracer loop 
     
    108107                
    109108               jl = n_trc_index(jn)  
     109               CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
     110               ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    110111 
    111112               SELECT CASE ( nn_zdmp_tr ) 
     
    115116                     DO jj = 2, jpjm1 
    116117                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                            ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     118                           ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    118119                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    119120                        END DO 
     
    126127                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    127128                           IF( avt(ji,jj,jk) <= 5.e-4 )  THEN  
    128                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     129                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    129130                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    130131                           ENDIF 
     
    138139                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    139140                           IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    140                               ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk,jl) - trb(ji,jj,jk,jn) ) 
     141                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    141142                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    142143                           END IF 
     
    156157         END DO                                                     ! tracer loop 
    157158         !                                                          ! =========== 
    158          CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     159         CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    159160      ENDIF 
    160161      ! 
     
    185186      ! 
    186187      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa 
    187       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta     ! 4D  workspace 
     188      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    188189 
    189190      !!---------------------------------------------------------------------- 
     
    267268         IF(lwp)  WRITE(numout,*) 
    268269         ! 
    269          CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )   ! Memory allocation 
    270          ! 
    271          CALL trc_dta( kt , ztrcdta )   ! read tracer data at nittrc000 
     270         CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )   ! Memory allocation 
    272271         ! 
    273272         DO jn = 1, jptra 
    274273            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    275274                jl = n_trc_index(jn) 
     275                CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
     276                ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
    276277                DO jc = 1, npncts 
    277278                   DO jk = 1, jpkm1 
    278279                      DO jj = nctsj1(jc), nctsj2(jc) 
    279280                         DO ji = nctsi1(jc), nctsi2(jc) 
    280                             trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk) 
     281                            trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk) 
    281282                            trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    282283                         ENDDO 
     
    286287             ENDIF 
    287288          ENDDO 
    288           CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     289          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    289290      ENDIF 
    290291      ! 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r3882 r4011  
    88   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
     10   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
    1011   !!---------------------------------------------------------------------- 
    1112#if  defined key_top  
     
    2829   PUBLIC   trc_dta_init    ! called in trcini.F90  
    2930 
     31   INTEGER  , PARAMETER, PUBLIC                        :: MAXTRC=100  ! maximum number of tracers  
    3032   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
    3133   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data 
    32    INTEGER  , SAVE                                     :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 
    33    REAL(wp) , SAVE,         ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values 
    34    TYPE(FLD), SAVE,         ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
     34   INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 
     35   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values 
     36   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    3537 
    3638   !! * Substitutions 
     
    4345CONTAINS 
    4446 
    45    SUBROUTINE trc_dta_init 
     47   SUBROUTINE trc_dta_init(ntrc) 
    4648      !!---------------------------------------------------------------------- 
    4749      !!                   ***  ROUTINE trc_dta_init  *** 
     
    5355      !!---------------------------------------------------------------------- 
    5456      ! 
     57      INTEGER,INTENT(IN) :: ntrc 
    5558      INTEGER            :: jl, jn                   ! dummy loop indicies 
    5659      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers 
     
    5962      ! 
    6063      CHARACTER(len=100) :: cn_dir 
    61       TYPE(FLD_N), DIMENSION(jptra) :: slf_i     ! array of namelist informations on the fields to read 
    62       TYPE(FLD_N), DIMENSION(jptra) :: sn_trcdta 
    63       REAL(wp)   , DIMENSION(jptra) :: rn_trfac    ! multiplicative factor for tracer values 
     64      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i     ! array of namelist informations on the fields to read 
     65      TYPE(FLD_N), DIMENSION(MAXTRC) :: sn_trcdta 
     66      REAL(wp)   , DIMENSION(MAXTRC) :: rn_trfac    ! multiplicative factor for tracer values 
    6467      !! 
    6568      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac  
     
    7174      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    7275      ! Compute the number of tracers to be initialised with data 
    73       ALLOCATE( n_trc_index(jptra), STAT=ierr0 ) 
     76      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7477      IF( ierr0 > 0 ) THEN 
    7578         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     
    7780      nb_trcdta      = 0 
    7881      n_trc_index(:) = 0 
    79       DO jn = 1, jptra 
     82      DO jn = 1, ntrc 
    8083         IF( ln_trc_ini(jn) ) THEN 
    8184             nb_trcdta       = nb_trcdta + 1  
     
    9396      ! 
    9497      cn_dir  = './'            ! directory in which the model is executed 
    95       DO jn = 1, jptra 
     98      DO jn = 1, ntrc 
    9699         WRITE( clndta,'("TR_",I1)' ) jn 
    97100         clndta = TRIM( clndta ) 
     
    107110 
    108111      IF( lwp ) THEN 
    109          DO jn = 1, jptra 
     112         DO jn = 1, ntrc 
    110113            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true 
    111114               clndta = TRIM( sn_trcdta(jn)%clvar )  
     
    129132         ENDIF 
    130133         ! 
    131          DO jn = 1, jptra 
     134         DO jn = 1, ntrc 
    132135            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    133136               jl = n_trc_index(jn) 
     
    152155 
    153156 
    154    SUBROUTINE trc_dta( kt, ptrc ) 
     157   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 
    155158      !!---------------------------------------------------------------------- 
    156159      !!                   ***  ROUTINE trc_dta  *** 
     
    162165      !!              - ln_trcdmp=F: deallocates the data structure as they are not used 
    163166      !! 
    164       !! ** Action  :   ptrc   passive tracer data on medl mesh and interpolated at time-step kt 
     167      !! ** Action  :   sf_dta   passive tracer data on medl mesh and interpolated at time-step kt 
    165168      !!---------------------------------------------------------------------- 
    166169      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
    167       REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   ptrc   ! passive tracer data 
    168       ! 
    169       INTEGER ::   ji, jj, jk, jl, jn, jkk, ik    ! dummy loop indicies 
     170      TYPE(FLD), DIMENSION(1)   , INTENT(inout) ::   sf_dta     ! array of information on the field to read 
     171      REAL(wp)                  , INTENT(in   ) ::   zrf_trfac  ! multiplication factor 
     172      ! 
     173      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
    170174      REAL(wp)::   zl, zi 
    171175      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
     
    177181      IF( nb_trcdta > 0 ) THEN 
    178182         ! 
    179          CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
    180          ! 
    181          DO jn = 1, ntra 
    182             ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:)    ! NO mask 
    183          ENDDO 
     183         CALL fld_read( kt, 1, sf_dta )      !==   read data at kt time step   ==! 
    184184         ! 
    185185         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     
    190190            ENDIF 
    191191            ! 
    192             DO jn = 1, ntra 
    193192               DO jj = 1, jpj                         ! vertical interpolation of T & S 
    194193                  DO ji = 1, jpi 
     
    196195                        zl = fsdept_0(ji,jj,jk) 
    197196                        IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data 
    198                            ztp(jk) =  ptrc(ji,jj,1    ,jn) 
     197                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,1) 
    199198                        ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data 
    200                            ztp(jk) =  ptrc(ji,jj,jpkm1,jn) 
     199                           ztp(jk) =  sf_dta(1)%fnow(ji,jj,jpkm1) 
    201200                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    202201                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    203202                              IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 
    204203                                 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 
    205                                  ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi  
     204                                 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 
     205                                           sf_dta(1)%fnow(ji,jj,jkk) ) * zi  
    206206                              ENDIF 
    207207                           END DO 
     
    209209                     END DO 
    210210                     DO jk = 1, jpkm1 
    211                         ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     211                        sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    212212                     END DO 
    213                      ptrc(ji,jj,jpk,jn) = 0._wp 
     213                     sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 
    214214                  END DO 
    215215               END DO 
    216             ENDDO  
    217216            !  
    218217         ELSE                                !==   z- or zps- coordinate   ==! 
    219218            !                              
    220             DO jn = 1, ntra 
    221                ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:)    ! Mask 
     219               sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    222220               ! 
    223221               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     
    227225                        IF( ik > 1 ) THEN 
    228226                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    229                            ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn) 
     227                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 
    230228                        ENDIF 
    231229                     END DO 
    232230                  END DO 
    233231               ENDIF 
    234             ENDDO  
    235             ! 
    236          ENDIF 
    237          ! 
    238          DO jn = 1, ntra 
    239             ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn)   !  multiplicative factor 
    240          ENDDO  
     232            ! 
     233         ENDIF 
     234         ! 
     235         sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac   !  multiplicative factor 
    241236         ! 
    242237         IF( lwp .AND. kt == nit000 ) THEN 
    243             DO jn = 1, ntra 
    244                clndta = TRIM( sf_trcdta(jn)%clvar )  
     238               clndta = TRIM( sf_dta(1)%clvar )  
    245239               WRITE(numout,*) ''//clndta//' data ' 
    246240               WRITE(numout,*) 
    247241               WRITE(numout,*)'  level = 1' 
    248                CALL prihre( ptrc(:,:,1    ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     242               CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    249243               WRITE(numout,*)'  level = ', jpk/2 
    250                CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     244               CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    251245               WRITE(numout,*)'  level = ', jpkm1 
    252                CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     246               CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    253247               WRITE(numout,*) 
    254             ENDDO 
    255          ENDIF 
    256           
     248         ENDIF 
    257249         IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !==   deallocate data structure   ==!  
    258250            !                                              (data used only for initialisation) 
    259251            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 
    260             DO jn = 1, ntra 
    261                                              DEALLOCATE( sf_trcdta(jn)%fnow )     !  arrays in the structure 
    262                IF( sf_trcdta(jn)%ln_tint )   DEALLOCATE( sf_trcdta(jn)%fdta ) 
    263             ENDDO 
    264                                              DEALLOCATE( sf_trcdta          )     ! the structure itself 
    265             ! 
    266          ENDIF 
    267          ! 
    268       ENDIF 
    269       !  
     252                                      DEALLOCATE( sf_dta(1)%fnow )     !  arrays in the structure 
     253            IF( sf_dta(1)%ln_tint )   DEALLOCATE( sf_dta(1)%fdta ) 
     254            ! 
     255         ENDIF 
     256      ENDIF 
     257      ! 
    270258      IF( nn_timing == 1 )  CALL timing_stop('trc_dta') 
    271259      ! 
     
    276264   !!---------------------------------------------------------------------- 
    277265CONTAINS 
    278    SUBROUTINE trc_dta( kt )        ! Empty routine 
     266   SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac )        ! Empty routine 
    279267      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    280268   END SUBROUTINE trc_dta 
  • branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r3680 r4011  
    2424   USE trcini_c14b     ! C14 bomb initialisation 
    2525   USE trcini_my_trc   ! MY_TRC   initialisation 
    26    USE trcdta          ! initialisation form files 
     26   USE trcdta          ! initialisation from files 
    2727   USE daymod          ! calendar manager 
    2828   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
     
    5858      INTEGER ::   jk, jn, jl    ! dummy loop indices 
    5959      CHARACTER (len=25) :: charout 
    60       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
     60      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
    6161      !!--------------------------------------------------------------------- 
    6262      ! 
     
    111111      ENDIF 
    112112 
    113       IF( ln_trcdta )      CALL trc_dta_init 
     113      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    114114 
    115115 
     
    122122        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    123123            ! 
    124             CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
    125             ! 
    126             CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     124            CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    127125            ! 
    128126            DO jn = 1, jptra 
    129127               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    130128                  jl = n_trc_index(jn)  
    131                   trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)   
     129                  CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) )   ! read tracer data at nit000 
     130                  ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 
     131                  trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)   
    132132               ENDIF 
    133133            ENDDO 
    134             CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     134            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    135135        ENDIF 
    136136        ! 
Note: See TracChangeset for help on using the changeset viewer.