Changeset 7835


Ignore:
Timestamp:
2017-03-24T16:06:42+01:00 (4 years ago)
Author:
dford
Message:

Initial attempt to add FABM. In theory this should give equivalent results to PML gitlab commit 2e51db55.

Location:
branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO
Files:
10 added
12 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r7566 r7835  
    4343   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1) 
    4444 
    45    INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100   !: maximum number of simultaneously opened file 
     45   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 200   !: maximum number of simultaneously opened file 
    4646   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 600  !: maximum number of variables in one file 
    4747   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r7567 r7835  
    5454      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index       
    5555      CHARACTER (len=22) :: charout 
     56      ! +++>>> FABM 
     57      INTEGER :: jn 
     58      ! FABM <<<+++ 
    5659      !!---------------------------------------------------------------------- 
    5760      ! 
     
    6871      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model 
    6972      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
    70  
     73      ! +++>>> FABM 
     74      IF( lk_fabm  )   THEN 
     75        DO jn=1,jp_fabm ! state variable loop 
     76          IF (lk_rad_fabm(jn)) THEN 
     77           CALL trc_rad_sms( kt, trb, trn, jn+jp_fabm_m1 , jn+jp_fabm_m1 ) 
     78          ENDIF 
     79        END DO 
     80      END IF 
     81      ! FABM <<<+++ 
    7182      ! 
    7283      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    r7566 r7835  
    2222   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input) 
    2323   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output) 
    24    LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
     24   ! --->>> FABM 
     25   ! LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
     26   ! FABM <<<--- 
     27   ! +++>>> FABM 
     28   LOGICAL, DIMENSION(jpmaxtrc) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
     29   ! FABM <<<+++ 
    2530 
    2631# if defined key_trdtrc && defined key_iomput 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r7566 r7835  
    1515   USE par_cfc       ! CFC 11 and 12 tracers 
    1616   USE par_my_trc    ! user defined passive tracers 
     17   ! +++>>> FABM 
     18   USE par_fabm      ! FABM 
     19   ! FABM <<<+++ 
    1720 
    1821   IMPLICIT NONE 
     
    2427   ! Passive tracers : Total size 
    2528   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     29   ! --->>> FABM 
     30   ! INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
     31   ! INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
     32   ! INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     33   ! FABM <<<--- 
     34   ! +++>>> FABM 
     35   INTEGER, PUBLIC  ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
     36   INTEGER, PUBLIC  ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
     37   INTEGER, PUBLIC  ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     38   ! FABM <<<+++ 
    2939   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     40   ! --->>> FABM 
     41   ! INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     42   ! FABM <<<--- 
     43   ! +++>>> FABM 
     44   INTEGER, PUBLIC  ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     45   ! FABM <<<+++ 
    3146    
    3247   !  1D configuration ("key_c1d") 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r7567 r7835  
    8383   END TYPE 
    8484 
    85    REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
     85   ! --->>> FABM  
     86   !REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
     87   !                                              trc_ice_prescr   ! prescribed ice trc cc 
     88   !CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
     89   ! FABM <<<--- 
     90   ! +++>>> FABM  
     91   REAL(wp), DIMENSION(jpmaxtrc), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
    8692                                                 trc_ice_prescr   ! prescribed ice trc cc 
    87    CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
     93   CHARACTER(len=2), DIMENSION(jpmaxtrc), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
     94   ! FABM <<<+++ 
    8895 
    8996   !! information for outputs 
     
    93100       CHARACTER(len = 80)  :: cllname  !: long name 
    94101       CHARACTER(len = 20)  :: clunit   !: unit 
    95        LOGICAL              :: llinit   !: read in a file or not 
    96 #if defined  key_my_trc 
    97        LOGICAL              :: llsbc   !: read in a file or not 
    98        LOGICAL              :: llcbc   !: read in a file or not 
    99        LOGICAL              :: llobc   !: read in a file or not 
    100 #endif 
    101        LOGICAL              :: llsave   !: save the tracer or not 
     102! --->>> FABM 
     103!       LOGICAL              :: llinit   !: read in a file or not 
     104!!#if defined  key_my_trc 
     105!       LOGICAL              :: llsbc   !: read in a file or not 
     106!       LOGICAL              :: llcbc   !: read in a file or not 
     107!       LOGICAL              :: llobc   !: read in a file or not 
     108!#endif 
     109!       LOGICAL              :: llsave   !: save the tracer or not 
     110! FABM <<<--- 
     111! +++ FABM 
     112       LOGICAL              :: llinit=.FALSE.   !: read in a file or not 
     113#if defined  key_fabm 
     114       LOGICAL              :: llsbc=.FALSE.   !: read in a file or not 
     115       LOGICAL              :: llcbc=.FALSE.   !: read in a file or not 
     116       LOGICAL              :: llobc=.FALSE.   !: read in a file or not 
     117#endif 
     118       LOGICAL              :: llsave=.FALSE.   !: save the tracer or not 
     119! FABM <<<+++ 
    102120   END TYPE PTRACER 
    103121   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name  
     
    228246         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    229247         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    230 #if defined key_my_trc 
     248! --->>> FABM 
     249!!#if defined key_my_trc 
     250! FABM <<<--- 
     251! +++>>> FABM 
     252#if defined key_fabm 
     253! FABM <<<+++ 
    231254         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
    232255#endif 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r7567 r7835  
    77   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
    88   !!---------------------------------------------------------------------- 
    9 #if  defined key_top  
     9#if defined key_top 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_top'                                                TOP model  
     
    2929   PUBLIC   trc_bc_read    ! called in trcstp.F90 or within 
    3030 
    31    INTEGER  , SAVE, PUBLIC                             :: nb_trcobc   ! number of tracers with open BC 
    32    INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc   ! number of tracers with surface BC 
    33    INTEGER  , SAVE, PUBLIC                             :: nb_trccbc   ! number of tracers with coastal BC 
     31   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC 
     32   INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc    ! number of tracers with surface BC 
     33   INTEGER  , SAVE, PUBLIC                             :: nb_trccbc    ! number of tracers with coastal BC 
    3434   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data 
    3535   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data 
    3636   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data 
    37    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac   ! multiplicative factor for SBC tracer values 
    38    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc   ! structure of data input SBC (file informations, fields read) 
    39    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac   ! multiplicative factor for CBC tracer values 
    40    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc   ! structure of data input CBC (file informations, fields read) 
     37   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trsfac    ! multiplicative factor for SBC tracer values 
     38   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcsbc    ! structure of data input SBC (file informations, fields read) 
     39   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trcfac    ! multiplicative factor for CBC tracer values 
     40   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trccbc    ! structure of data input CBC (file informations, fields read) 
    4141   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:)  :: rf_trofac    ! multiplicative factor for OBCtracer values 
    4242   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read) 
     
    6565      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6666      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    67       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     67      INTEGER            :: ios                            ! Local integer output status for namelist read 
    6868      INTEGER            :: nblen, igrd                    ! support arrays for BDY 
    6969      CHARACTER(len=100) :: clndta, clntrc 
     
    130130      DO ib = 1, nb_bdy 
    131131#endif 
    132       READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    133 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
    134       IF(lwm) WRITE ( numont, namtrc_bc ) 
     132        READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
     133902     IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
     134        IF(lwm) WRITE ( numont, namtrc_bc ) 
    135135#if defined key_bdy 
    136136        sn_trcobc(:,ib)=sn_trcobc2(:) 
     
    190190         IF ( nb_trcsbc > 0 ) THEN 
    191191            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
    192          DO jn = 1, ntrc 
     192            DO jn = 1, ntrc 
    193193               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
    194194            ENDDO 
    195             ENDIF 
     195         ENDIF 
    196196         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
    197197 
     
    203203               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
    204204            ENDDO 
    205             ENDIF 
     205         ENDIF 
    206206         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
    207207 
     
    227227                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
    228228                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
    229             ENDIF 
    230          END DO 
    231       ENDIF 
     229                ENDIF 
     230            ENDDO 
     231         ENDIF 
    232232#endif 
    233233         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     
    243243         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 
    244244         IF( ierr1 > 0 ) THEN 
    245             CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN 
     245            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
    246246         ENDIF 
    247247 
     
    249249 
    250250         DO ib = 1, nb_bdy 
    251          DO jn = 1, ntrc 
     251            DO jn = 1, ntrc 
    252252 
    253253               nblen = idx_bdy(ib)%nblen(igrd) 
     
    255255               IF ( ln_trc_obc(jn) ) THEN 
    256256               ! Initialise from external data 
    257                jl = n_trc_indobc(jn) 
     257                  jl = n_trc_indobc(jn) 
    258258                  slf_i(jl)    = sn_trcobc(jn,ib) 
    259259                  rf_trofac(jl,ib) = rn_trofac(jn) 
    260260                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
    261261                  IF( sn_trcobc(jn,ib)%ln_tint )  ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
    262                IF( ierr2 + ierr3 > 0 ) THEN 
    263                  CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
    264                ENDIF 
     262                  IF( ierr2 + ierr3 > 0 ) THEN 
     263                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     264                  ENDIF 
    265265                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 
    266266                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 
     
    279279                  END DO 
    280280                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    281             ENDIF 
    282          ENDDO 
     281               ENDIF 
     282            ENDDO 
    283283            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    284284         ENDDO 
     
    371371      IF ( PRESENT(jit) ) THEN  
    372372 
     373#ifdef key_bdy 
    373374         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
    374       IF( nb_trcobc > 0 ) THEN 
     375         IF( nb_trcobc > 0 ) THEN 
    375376           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
    376377           DO ib = 1,nb_bdy 
    377378             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 
    378379           ENDDO 
    379       ENDIF 
    380  
    381       ! SURFACE boundary conditions        
    382       IF( nb_trcsbc > 0 ) THEN 
     380         ENDIF 
     381#endif 
     382 
     383         ! SURFACE boundary conditions 
     384         IF( nb_trcsbc > 0 ) THEN 
    383385           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
    384386           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
    385       ENDIF 
    386  
    387       ! COASTAL boundary conditions        
    388       IF( nb_trccbc > 0 ) THEN 
     387         ENDIF 
     388 
     389         ! COASTAL boundary conditions 
     390         IF( nb_trccbc > 0 ) THEN 
    389391           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
    390392           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
    391       ENDIF    
     393         ENDIF 
    392394 
    393395      ELSE 
    394396 
     397#ifdef key_bdy 
    395398         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
    396399         IF( nb_trcobc > 0 ) THEN 
     
    400403           ENDDO 
    401404         ENDIF 
     405#endif 
    402406 
    403407         ! SURFACE boundary conditions 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90

    r7567 r7835  
    3434   !!---------------------------------------------------------------------- 
    3535   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    36    !! $Id$ 
     36   !! $Id$  
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
     
    167167      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    168168      !!  
    169       REAL(wp) ::   zwgt           ! boundary weight 
     169      REAL(wp) ::   zcoef, zcoef1, zcoef2           ! boundary weight 
    170170      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    171       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses 
     171      INTEGER  ::   ii, ij, ip, jp   ! 2D addresses 
    172172      !!---------------------------------------------------------------------- 
    173173      ! 
     
    180180         DO ik = 1, jpkm1 
    181181            ! search the sense of the gradient 
    182             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    183             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    184             IF ( zcoef1+zcoef2 == 0) THEN 
     182            zcoef1 = bdytmask(ii-1,ij  )*tmask(ii-1,ij,ik) +  bdytmask(ii+1,ij  )*tmask(ii+1,ij,ik) 
     183            zcoef2 = bdytmask(ii  ,ij-1)*tmask(ii,ij-1,ik) +  bdytmask(ii  ,ij+1)*tmask(ii,ij+1,ik) 
     184            IF ( nint(zcoef1+zcoef2) == 0) THEN 
    185185               ! corner 
    186186               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    187                tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + & 
    188                  &                tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + & 
    189                  &                tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + & 
    190                  &                tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik) 
    191                tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
     187               IF (zcoef > .5_wp) THEN ! Only set not isolated points. 
     188                 tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + & 
     189                   &              tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + & 
     190                   &              tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + & 
     191                   &              tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik) 
     192                 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / zcoef ) * tmask(ii,ij,ik) 
     193               ENDIF 
     194            ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 
     195               ! oblique corner 
     196               zcoef = tmask(ii-1,ij,ik)*bdytmask(ii-1,ij  ) + tmask(ii+1,ij,ik)*bdytmask(ii+1,ij  ) + & 
     197                  &  tmask(ii,ij-1,ik)*bdytmask(ii,ij -1 ) +  tmask(ii,ij+1,ik)*bdytmask(ii,ij+1  ) 
     198               tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik)*bdytmask(ii-1,ij  ) + & 
     199                  &              tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik)*bdytmask(ii+1,ij  )  + & 
     200                  &              tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik)*bdytmask(ii,ij -1 ) + & 
     201                  &              tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik)*bdytmask(ii,ij+1  ) 
     202  
     203               tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX(1._wp, zcoef) ) * tmask(ii,ij,ik) 
    192204            ELSE 
    193                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    194                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    195                tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) 
     205               ip = nint(bdytmask(ii+1,ij  )*tmask(ii+1,ij,ik) - bdytmask(ii-1,ij  )*tmask(ii-1,ij,ik)) 
     206               jp = nint(bdytmask(ii  ,ij+1)*tmask(ii,ij+1,ik) - bdytmask(ii  ,ij-1)*tmask(ii,ij-1,ik)) 
     207               tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
    196208            ENDIF 
    197209         END DO 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7567 r7835  
    2424   USE trcini_c14b     ! C14 bomb initialisation 
    2525   USE trcini_my_trc   ! MY_TRC   initialisation 
     26   ! +++>>> FABM 
     27   USE trcsms_fabm     ! FABM initialisation 
     28   USE trcini_fabm     ! FABM initialisation 
     29   ! FABM <<<FABM 
    2630   USE trcdta          ! initialisation from files 
    2731   USE daymod          ! calendar manager 
     
    7074      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    7175      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     76      ! +++>>> FABM 
     77      ! Allow FABM to update numbers of biogeochemical tracers, diagnostics (jptra etc.) 
     78      IF( lk_fabm ) CALL nemo_fabm_init 
     79      ! FABM <<<+++ 
    7280 
    7381      CALL top_alloc()              ! allocate TOP arrays 
     
    102110      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    103111      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     112      ! +++>>> FABM 
     113      IF( lk_fabm    )       CALL trc_ini_fabm         ! FABM    tracers 
     114      ! FABM <<<+++ 
    104115 
    105116      CALL trc_ice_ini                                 ! Tracers in sea ice 
     
    141152            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    142153        ENDIF 
    143 ! slwa temporary insert initialise tracer 
    144             trn(:,:,:,:)  = 0._wp 
    145             if(nproc.eq.39)then 
    146               DO jn = 1, jptra 
    147                   trn(:,:,:,jn) = 100._wp * tmask(:,:,:) 
    148               ENDDO 
    149             endif 
    150 !!!! slwa temp 
    151         ! 
    152         trb(:,:,:,:) = trn(:,:,:,:) 
    153         !  
    154       ENDIF 
     154      ENDIF 
     155      ! --->>> FABM 
    155156! Initialisation of tracers Boundary Conditions  - here so that you can use initial condition as boundary 
    156       IF( lk_my_trc )     CALL trc_bc_init(jptra) 
     157      !IF( lk_my_trc )     CALL trc_bc_init(jptra) 
     158      ! FABM <<<--- 
     159      ! FABM +++>>> 
     160! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary) 
     161      IF( lk_fabm )     THEN 
     162          wndm=0._wp !uninitiased field at this point 
     163          qsr=0._wp !uninitiased field at this point 
     164          CALL compute_fabm ! only needed to set-up diagnostics 
     165          CALL trc_bc_init(jptra) 
     166      ENDIF 
     167      ! FABM <<<+++ 
    157168  
    158169      tra(:,:,:,:) = 0._wp 
     
    169180      trai(:) = 0._wp                                                   ! initial content of all tracers 
    170181      DO jn = 1, jptra 
    171          trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     182         !trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     183         trai(jn) = trai(jn) 
    172184      END DO 
    173185 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7567 r7835  
    2525   USE trcnam_c14b       ! C14 SMS namelist 
    2626   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     27   ! +++>>> FABM 
     28   USE trcnam_fabm       ! FABM SMS namelist 
     29   ! FABM <<<+++ 
    2730   USE trd_oce        
    2831   USE trdtrc_oce 
     
    178181      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    179182      ENDIF 
     183 
     184      ! +++>>> FABM 
     185      IF( lk_fabm    ) THEN   ;   CALL trc_nam_fabm        ! FABM tracers 
     186      ELSE                    ;   IF(lwp) WRITE(numout,*) '          FABM not used' 
     187      ENDIF 
     188      ! FABM <<<+++ 
    180189      ! 
    181190   END SUBROUTINE trc_nam 
     
    197206 
    198207 
    199       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     208      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
    200209      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    201210 
     
    244253 
    245254      ! --- Namelist declarations --- ! 
    246       TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     255      ! --->>> FABM 
     256      !TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     257      ! FABM <<<---  
     258      ! +++>>> FABM 
     259      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 
     260      ! FABM <<<+++  
    247261      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    248262 
     
    288302      !! 
    289303      !!--------------------------------------------------------------------- 
    290       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    291       !! 
    292       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
     304      ! --->>> FABM 
     305      !TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     306      ! FABM <<<--- 
     307      ! +++>>> FABM 
     308      TYPE(PTRACER), DIMENSION(jpmaxtrc) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     309      ! FABM <<<+++ 
     310      !! 
     311      NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 
    293312   
    294313      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     
    296315      !!--------------------------------------------------------------------- 
    297316      IF(lwp) WRITE(numout,*) 
    298       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     317      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    299318      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    300319 
     320      ! Initialise logical flags to .FALSE.: 
     321      sn_tracer(:)%llinit = .FALSE. 
     322      sn_tracer(:)%llsave = .FALSE. 
     323#ifdef key_fabm 
     324      sn_tracer(:)%llsbc = .FALSE. 
     325      sn_tracer(:)%llcbc = .FALSE. 
     326      sn_tracer(:)%llcbc = .FALSE. 
     327#endif 
    301328 
    302329      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
     
    314341         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    315342         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
    316 #if defined key_my_trc 
     343! --->>> FABM 
     344!!#if defined key_my_trc 
     345! FABM <<<--- 
     346! +++>>> FABM 
     347#if defined key_fabm 
     348! FABM <<<+++ 
    317349         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
    318350         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     
    321353         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    322354      END DO 
    323        
     355      
     356      ! +++>>> FABM 
     357      if (lk_fabm) CALL trc_nam_fabm_override 
     358      ! FABM <<<+++ 
    324359    END SUBROUTINE trc_nam_trc 
    325360 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7566 r7835  
    2828   USE iom 
    2929   USE daymod 
     30   ! +++>>> FABM 
     31   USE trcrst_fabm 
     32   ! FABM <<<+++ 
    3033   IMPLICIT NONE 
    3134   PRIVATE 
     
    117120         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    118121      END DO 
     122      ! +++>>> FABM 
     123 
     124      IF (lk_fabm) CALL trc_rst_read_fabm 
     125      ! FABM <<<+++ 
    119126      ! 
    120127   END SUBROUTINE trc_rst_read 
     
    142149         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    143150      END DO 
     151      ! +++>>> FABM 
     152      IF (lk_fabm) CALL trc_rst_wri_fabm(kt) 
     153      ! FABM <<<+++ 
    144154      ! 
    145155      IF( kt == nitrst ) THEN 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r7566 r7835  
    1919   USE trcsms_c14b        ! C14b tracer  
    2020   USE trcsms_my_trc      ! MY_TRC  tracers 
     21   ! +++>>>> FABM 
     22   USE trcsms_fabm        ! FABM tracers 
     23   ! FABM <<<+++ 
    2124   USE prtctl_trc         ! Print control for debbuging 
    2225 
     
    5255      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
    5356      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
     57      ! +++>>> FABM 
     58      IF( lk_fabm    )   CALL trc_sms_fabm ( kt )      ! FABM tracers 
     59      ! FABM <<<+++ 
    5460 
    5561      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
  • branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r7567 r7835  
    2121   USE trcwri_c14b 
    2222   USE trcwri_my_trc 
     23   ! +++>>> FABM 
     24   USE trcwri_fabm 
     25   ! FABM <<<+++ 
    2326 
    2427   IMPLICIT NONE 
     
    7275      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    7376#endif 
     77      ! +++>>>FABM 
     78      IF( lk_fabm    )   CALL trc_wri_fabm      ! FABM tracers 
     79      ! FABM <<<+++ 
    7480      ! 
    7581      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.