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 7829 – NEMO

Changeset 7829


Ignore:
Timestamp:
2017-03-23T15:36:14+01:00 (7 years ago)
Author:
dford
Message:

Add a version of the NEMO-FABM coupling code. In theory, this should give equivalent results to PML gitlab commit 2e51db55.

Location:
branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO
Files:
11 added
20 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r7827 r7829  
    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/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r7827 r7829  
    1818   USE trd_oce 
    1919   USE trdtrc 
     20   USE trcbc, only : trc_bc_read 
    2021 
    2122   IMPLICIT NONE 
    … …  
    5556 
    5657      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
     58 
     59      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions 
    5760 
    5861      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r7827 r7829  
    1919 
    2020   PUBLIC trc_wri_my_trc  
     21#if defined key_tracer_budget 
     22   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: trb_temp ! slwa 
     23#endif 
     24 
    2125 
    2226#  include "top_substitute.h90" 
    2327CONTAINS 
    2428 
     29#if defined key_tracer_budget 
     30   SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa 
     31#else 
    2532   SUBROUTINE trc_wri_my_trc 
     33#endif 
    2634      !!--------------------------------------------------------------------- 
    2735      !!                     ***  ROUTINE trc_wri_trc  *** 
    … …  
    2937      !! ** Purpose :   output passive tracers fields  
    3038      !!--------------------------------------------------------------------- 
     39#if defined key_tracer_budget 
     40      INTEGER, INTENT( in ), OPTIONAL     :: fl  
     41      INTEGER, INTENT( in )               :: kt 
     42      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: trpool !tracer pool temporary output 
     43#endif 
    3144      CHARACTER (len=20)   :: cltra 
    32       INTEGER              :: jn 
     45      INTEGER              :: jn,jk 
    3346      !!--------------------------------------------------------------------- 
    3447  
    3548      ! write the tracer concentrations in the file 
    3649      ! --------------------------------------- 
     50 
     51 
     52#if defined key_tracer_budget 
     53      IF( PRESENT(fl)) THEN 
     54! depth integrated 
     55! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 
     56         DO jn = jp_myt0, jp_myt1  
     57            trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) +  & 
     58                                        trb_temp(:,:,:,jn) * fse3t(:,:,:) ) 
     59! 
     60            cltra = TRIM( ctrcnm(jn) )                  ! output of tracer density  
     61            CALL iom_put( cltra, trpool(:,:,:) / (0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) ) ) 
     62! 
     63            cltra = TRIM( ctrcnm(jn) )//"_pool"     ! volume integrated output 
     64            DO jk = 1, jpk 
     65               trpool(:,:,jk) = trpool(:,:,jk) * e1t(:,:) * e2t(:,:) 
     66            END DO 
     67            CALL iom_put( cltra, trpool) 
     68 
     69!           cltra = TRIM( ctrcnm(jn) )//"_pool"     ! volume integrated output 
     70!           DO jk = 1, jpk 
     71!              trpool(:,:,jk) = 0.5 * ( trn(:,:,jk,jn) * fse3t_a(:,:,jk) +  &  
     72!                                       trb_temp(:,:,jk,jn) * fse3t(:,:,jk) ) * &  
     73!                                       e1t(:,:) * e2t(:,:) 
     74!           END DO 
     75!           CALL iom_put( cltra, trpool) 
     76!           cltra = TRIM( ctrcnm(jn) )                  ! output of tracer density  
     77!           CALL iom_put( cltra, trpool(:,:,:) / (0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) ) ) 
     78         END DO 
     79         CALL iom_put( "DEPTH" , 0.5* (fse3t(:,:,:) + fse3t_a(:,:,:) ) )  !  equivalent 'depth' at same time as tracer pool output 
     80      ELSE 
     81 
     82         IF( kt == nittrc000 ) THEN 
     83           ALLOCATE(trb_temp(jpi,jpj,jpk,jptra))  ! slwa 
     84         ENDIF 
     85         trb_temp(:,:,:,:)=trn(:,:,:,:) ! slwa save for tracer budget (unfiltered trn) 
     86 
     87!        DO jn = jp_myt0, jp_myt1 
     88!           cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
     89!           CALL iom_put( cltra, trn(:,:,:,jn) )  
     90!        END DO 
     91! write out depths and areas in double precision for tracer budget calculations 
     92         CALL iom_put( "AREA" , e1t(:,:) * e2t(:,:)) 
     93!        CALL iom_put( "DEPTH" , fse3t(:,:,:) )  ! need depth at same time as tracer output 
     94 
     95      END IF 
     96#else 
    3797      DO jn = jp_myt0, jp_myt1 
    3898         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    3999         CALL iom_put( cltra, trn(:,:,:,jn) ) 
    40100      END DO 
     101#endif 
    41102      ! 
    42103   END SUBROUTINE trc_wri_my_trc 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r7827 r7829  
    5656      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5757      !! 
    58       INTEGER            :: jn 
     58      INTEGER            :: jn, jk 
    5959      CHARACTER (len=22) :: charout 
    6060      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    … …  
    105105        DO jn = 1, jptra 
    106106           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     107#if defined key_tracer_budget 
     108           DO jk = 1, jpkm1 
     109             ztrtrd(:,:,jk,jn) = ztrtrd(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk)  ! slwa 
     110           END DO 
     111#endif 
    107112           CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 
    108113        END DO 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r7827 r7829  
    3333   USE trdtra 
    3434   USE tranxt 
     35   USE trcbdy          ! BDY open boundaries 
     36   USE bdy_par, only: lk_bdy 
     37   USE iom 
    3538# if defined key_agrif 
    3639   USE agrif_top_interp 
    … …  
    9396      CHARACTER (len=22) :: charout 
    9497      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt  
     98#if defined key_tracer_budget 
     99      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrdt_m1 ! slwa 
     100#endif 
    95101      !!---------------------------------------------------------------------- 
    96102      ! 
    … …  
    101107         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    102108      ENDIF 
    103  
     109#if defined key_tracer_budget 
     110      IF( kt == nittrc000 .AND. l_trdtrc ) THEN 
     111         ALLOCATE( ztrdt_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     112         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     113            iom_varid( numrtr, 'atf_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN 
     114            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc ATF tracer trend read in the restart file' 
     115            DO jn = 1, jptra 
     116               CALL iom_get( numrtr, jpdom_autoglo, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) )   ! before tracer trend for atf 
     117            END DO 
     118         ELSE           
     119           ztrdt_m1=0.0 
     120         ENDIF 
     121      ENDIF 
     122#endif 
     123 
     124 
     125#if defined key_agrif 
     126      CALL Agrif_trc                   ! AGRIF zoom boundaries 
     127#endif 
    104128      ! Update after tracer on domain lateral boundaries 
    105129      DO jn = 1, jptra 
    … …  
    108132 
    109133 
    110 #if defined key_bdy 
    111 !!      CALL bdy_trc( kt )               ! BDY open boundaries 
    112 #endif 
    113 #if defined key_agrif 
    114       CALL Agrif_trc                   ! AGRIF zoom boundaries 
    115 #endif 
     134      IF( lk_bdy )  CALL trc_bdy( kt )               ! BDY open boundaries 
    116135 
    117136 
    … …  
    149168               zfact = 1.e0 / r2dt(jk)   
    150169               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
    151                CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
     170!slwa          CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 
     171#if defined key_tracer_budget 
     172               ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_n(:,:,jk)  ! slwa vvl 
     173               !ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_0(:,:,jk)  ! slwa CHANGE for vvl 
     174#endif 
    152175            END DO 
     176#if defined key_tracer_budget 
     177! slwa budget code 
     178              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt_m1(:,:,:,jn) ) 
     179#else 
     180              CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 
     181#endif 
    153182         END DO 
     183#if defined key_tracer_budget 
     184        ztrdt_m1(:,:,:,:) = ztrdt(:,:,:,:)    ! need previous time step for budget slwa 
     185#endif 
    154186         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )  
    155187      END IF 
     188 
     189#if defined key_tracer_budget 
     190      !                                           Write in the tracer restart file 
     191      !                                          ******************************* 
     192      IF( lrst_trc ) THEN 
     193         IF(lwp) WRITE(numout,*) 
     194         IF(lwp) WRITE(numout,*) 'trc : ATF trend at last time step for tracer budget written in tracer restart file ',   & 
     195            &                    'at it= ', kt,' date= ', ndastp 
     196         IF(lwp) WRITE(numout,*) '~~~~' 
     197         DO jn = 1, jptra 
     198            CALL iom_rstput( kt, nitrst, numrtw, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) ) 
     199         END DO 
     200      ENDIF 
     201#endif 
     202 
    156203      ! 
    157204      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r7827 r7829  
    1818   USE trdtra 
    1919   USE prtctl_trc          ! Print control for debbuging 
     20#if defined key_tracer_budget 
     21   USE iom 
     22#endif 
    2023 
    2124   IMPLICIT NONE 
    … …  
    5154      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index       
    5255      CHARACTER (len=22) :: charout 
     56      ! +++>>> FABM 
     57      INTEGER :: jn 
     58      ! FABM <<<+++ 
    5359      !!---------------------------------------------------------------------- 
    5460      ! 
    … …  
    6571      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model 
    6672      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
    67  
     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 <<<+++ 
    6882      ! 
    6983      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    … …  
    110124      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    111125      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
     126#if defined key_tracer_budget 
     127      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrtrdb_m1 ! slwa  
     128#endif 
    112129      REAL(wp) :: zs2rdt 
    113130      LOGICAL ::   lldebug = .FALSE. 
    … …  
    116133  
    117134      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
     135#if defined key_tracer_budget 
     136      IF( kt == nittrc000 .AND. l_trdtrc) THEN 
     137         ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     138         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     139            iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN 
     140            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc RDB tracer trend read in the restart file' 
     141            DO jn = 1, jptra 
     142               CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )   ! before tracer trend for rdb 
     143            END DO 
     144         ELSE 
     145           ztrtrdb_m1=0.0 
     146         ENDIF 
     147      ENDIF 
     148#endif 
    118149       
    119150      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    … …  
    156187               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    157188               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     189#if defined key_tracer_budget 
     190! slwa budget code 
     191               DO jk = 1, jpkm1 
     192                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     193                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     194               END DO 
     195               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     196               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     197#else 
    158198               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     199#endif 
    159200               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    160201              ! 
    … …  
    187228               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    188229               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     230#if defined key_tracer_budget 
     231! slwa budget code 
     232               DO jk = 1, jpkm1 
     233                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     234                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     235               END DO 
     236               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     237               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     238#else 
    189239               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     240#endif 
    190241               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    191242              ! 
    … …  
    195246 
    196247      ENDIF 
     248 
     249#if defined key_tracer_budget 
     250      !                                           Write in the tracer restart file 
     251      !                                          ******************************* 
     252      IF( lrst_trc ) THEN 
     253         IF(lwp) WRITE(numout,*) 
     254         IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ',   & 
     255            &                    'at it= ', kt,' date= ', ndastp 
     256         IF(lwp) WRITE(numout,*) '~~~~' 
     257         DO jn = 1, jptra 
     258            CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) 
     259         END DO 
     260      ENDIF 
     261#endif 
    197262 
    198263      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r7827 r7829  
    113113           sbc_trc_b(:,:,:) = 0._wp 
    114114         ENDIF 
     115         sbc_trc(:,:,:) = 0._wp    !slwa initialise for vvl 
    115116      ELSE                                         ! Swap of forcing fields 
    116117         IF( ln_top_euler ) THEN 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r7827 r7829  
    2727   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2828   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     29   USE trcbdy          ! BDY open boundaries 
     30   USE bdy_par, only: lk_bdy 
    2931 
    3032#if defined key_agrif 
    … …  
    6870         IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    6971         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
     72         IF( lk_bdy )           CALL trc_bdy_dmp( kstp )        ! BDY damping trends 
    7073                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
    7174                                CALL trc_ldf( kstp )            ! lateral mixing 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    r7827 r7829  
    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/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r7827 r7829  
    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/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r7827 r7829  
    1414   USE par_oce 
    1515   USE par_trc 
     16#if defined key_bdy 
     17   USE bdy_oce, only: nb_bdy, OBC_DATA 
     18#endif 
    1619    
    1720   IMPLICIT NONE 
    … …  
    8083   END TYPE 
    8184 
    82    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 
    8392                                                 trc_ice_prescr   ! prescribed ice trc cc 
    84    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 <<<+++ 
    8595 
    8696   !! information for outputs 
    … …  
    90100       CHARACTER(len = 80)  :: cllname  !: long name 
    91101       CHARACTER(len = 20)  :: clunit   !: unit 
    92        LOGICAL              :: llinit   !: read in a file or not 
    93        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 <<<+++ 
    94120   END TYPE PTRACER 
    95121   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name  
    … …  
    191217# endif 
    192218   ! 
     219#if defined key_bdy 
     220   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 
     221   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
     222   INTEGER,           PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  nn_trcdmp_bdy        !: =T Tracer damping 
     223   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
     224   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
     225#endif 
    193226 
    194227   !!---------------------------------------------------------------------- 
    … …  
    213246         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    214247         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
     248! --->>> FABM 
     249!!#if defined key_my_trc 
     250! FABM <<<--- 
     251! +++>>> FABM 
     252#if defined key_fabm 
     253! FABM <<<+++ 
     254         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     255#endif 
     256#if defined key_bdy 
     257         &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       & 
     258         &      trcdta_bdy(jptra,nb_bdy)                                              ,       & 
     259#endif 
    215260         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )   
    216261 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r7827 r7829  
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
    6    !!---------------------------------------------------------------------- 
    7 #if  defined key_top  
     6   !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original 
     7   !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
     8   !!---------------------------------------------------------------------- 
     9#if defined key_top 
    810   !!---------------------------------------------------------------------- 
    911   !!   'key_top'                                                TOP model  
    1012   !!---------------------------------------------------------------------- 
    11    !!   trc_dta    : read and time interpolated passive tracer data 
     13   !!   trc_bc       : read and time interpolated tracer Boundary Conditions 
    1214   !!---------------------------------------------------------------------- 
    1315   USE par_trc       !  passive tracers parameters 
    … …  
    1719   USE lib_mpp       !  MPP library 
    1820   USE fldread       !  read input fields 
     21#if defined key_bdy 
     22   USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 
     23#endif 
    1924 
    2025   IMPLICIT NONE 
    … …  
    2429   PUBLIC   trc_bc_read    ! called in trcstp.F90 or within 
    2530 
    26    INTEGER  , SAVE, PUBLIC                             :: nb_trcobc   ! number of tracers with open BC 
    27    INTEGER  , SAVE, PUBLIC                             :: nb_trcsbc   ! number of tracers with surface BC 
    28    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 
    2934   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indobc ! index of tracer with OBC data 
    3035   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indsbc ! index of tracer with SBC data 
    3136   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_indcbc ! index of tracer with CBC data 
    32    INTEGER  , SAVE, PUBLIC                             :: ntra_obc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    33    INTEGER  , SAVE, PUBLIC                             :: ntra_sbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    34    INTEGER  , SAVE, PUBLIC                             :: ntra_cbc     ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 
    35    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trofac   ! multiplicative factor for OBCtracer values 
    36    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcobc   ! structure of data input OBC (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) 
     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) 
     41   REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:)  :: rf_trofac    ! multiplicative factor for OBCtracer values 
     42   TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET  :: sf_trcobc    ! structure of data input OBC (file informations, fields read) 
     43   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:,:) :: nbmap_ptr   ! array of pointers to nbmap 
    4144 
    4245   !! * Substitutions 
    4346#  include "domzgr_substitute.h90" 
    4447   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     48   !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
    4649   !! $Id$ 
    4750   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    6063      ! 
    6164      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    62       INTEGER            :: jl, jn                         ! dummy loop indices 
     65      INTEGER            :: jl, jn , ib, ibd, ii, ij, ik   ! dummy loop indices 
    6366      INTEGER            :: ierr0, ierr1, ierr2, ierr3     ! temporary integers 
    64       INTEGER            ::  ios                           ! Local integer output status for namelist read 
     67      INTEGER            :: ios                            ! Local integer output status for namelist read 
     68      INTEGER            :: nblen, igrd                    ! support arrays for BDY 
    6569      CHARACTER(len=100) :: clndta, clntrc 
    6670      ! 
    67       CHARACTER(len=100) :: cn_dir 
     71      CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 
     72 
    6873      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i  ! local array of namelist informations on the fields to read 
    69       TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc    ! open 
     74      TYPE(FLD_N), DIMENSION(jpmaxtrc,2) :: sn_trcobc  ! open 
     75      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc2   ! to read in multiple (2) open bdy 
    7076      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc    ! surface 
    7177      TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc    ! coastal 
    … …  
    7480      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values 
    7581      !! 
    76       NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac  
     82      NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc2, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
     83#if defined key_bdy 
     84      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
     85#endif 
    7786      !!---------------------------------------------------------------------- 
    7887      IF( nn_timing == 1 )  CALL timing_start('trc_bc_init') 
    7988      ! 
     89      IF( lwp ) THEN 
     90         WRITE(numout,*) ' ' 
     91         WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 
     92         WRITE(numout,*) '~~~~~~~~~~~ ' 
     93      ENDIF 
    8094      !  Initialisation and local array allocation 
    8195      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    … …  
    107121      n_trc_indcbc(:) = 0 
    108122      ! 
    109       DO jn = 1, ntrc 
    110          IF( ln_trc_obc(jn) ) THEN 
    111              nb_trcobc       = nb_trcobc + 1  
    112              n_trc_indobc(jn) = nb_trcobc  
    113          ENDIF 
    114          IF( ln_trc_sbc(jn) ) THEN 
    115              nb_trcsbc       = nb_trcsbc + 1 
    116              n_trc_indsbc(jn) = nb_trcsbc 
    117          ENDIF 
    118          IF( ln_trc_cbc(jn) ) THEN 
    119              nb_trccbc       = nb_trccbc + 1 
    120              n_trc_indcbc(jn) = nb_trccbc 
    121          ENDIF 
    122       ENDDO 
    123       ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking 
    124       IF( lwp ) WRITE(numout,*) ' ' 
    125       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 
    126       IF( lwp ) WRITE(numout,*) ' ' 
    127       ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking 
    128       IF( lwp ) WRITE(numout,*) ' ' 
    129       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 
    130       IF( lwp ) WRITE(numout,*) ' ' 
    131       ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking 
    132       IF( lwp ) WRITE(numout,*) ' ' 
    133       IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 
    134       IF( lwp ) WRITE(numout,*) ' ' 
    135  
     123      ! Read Boundary Conditions Namelists 
    136124      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    137125      READ  ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) 
    … …  
    139127 
    140128      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    141       READ  ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 
    142 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 
    143       IF(lwm) WRITE ( numont, namtrc_bc ) 
    144  
    145       ! print some information for each  
     129#if defined key_bdy 
     130      DO ib = 1, nb_bdy 
     131#endif 
     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 ) 
     135#if defined key_bdy 
     136        sn_trcobc(:,ib)=sn_trcobc2(:) 
     137      ENDDO 
     138#endif 
     139 
     140#if defined key_bdy 
     141      REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
     142      READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
     143903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     144 
     145      REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
     146      READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
     147904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     148      IF(lwm) WRITE ( numont, namtrc_bdy ) 
     149      ! setup up preliminary informations for BDY structure 
     150      DO jn = 1, ntrc 
     151         DO ib = 1, nb_bdy 
     152            ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
     153            IF ( ln_trc_obc(jn) ) THEN 
     154               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
     155            ELSE 
     156               trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
     157            ENDIF 
     158            ! set damping use in BDY data structure 
     159            trcdta_bdy(jn,ib)%dmp = .false. 
     160            IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
     161            IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
     162            IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
     163                & CALL ctl_stop( 'Use FRS OR relaxation' ) 
     164            IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
     165                & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     166         ENDDO 
     167      ENDDO 
     168 
     169#else 
     170      ! Force all tracers OBC to false if bdy not used 
     171      ln_trc_obc = .false. 
     172#endif 
     173      ! compose BC data indexes 
     174      DO jn = 1, ntrc 
     175         IF( ln_trc_obc(jn) ) THEN 
     176             nb_trcobc       = nb_trcobc + 1  ; n_trc_indobc(jn) = nb_trcobc 
     177         ENDIF 
     178         IF( ln_trc_sbc(jn) ) THEN 
     179             nb_trcsbc       = nb_trcsbc + 1  ; n_trc_indsbc(jn) = nb_trcsbc 
     180         ENDIF 
     181         IF( ln_trc_cbc(jn) ) THEN 
     182             nb_trccbc       = nb_trccbc + 1  ; n_trc_indcbc(jn) = nb_trccbc 
     183         ENDIF 
     184      ENDDO 
     185 
     186      ! Print summmary of Boundary Conditions 
    146187      IF( lwp ) THEN 
    147          DO jn = 1, ntrc 
    148             IF( ln_trc_obc(jn) )  THEN     
    149                clndta = TRIM( sn_trcobc(jn)%clvar )  
    150                IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    151                &               ' multiplicative factor : ', rn_trofac(jn) 
    152             ENDIF 
    153             IF( ln_trc_sbc(jn) )  THEN     
    154                clndta = TRIM( sn_trcsbc(jn)%clvar )  
    155                IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    156                &               ' multiplicative factor : ', rn_trsfac(jn) 
    157             ENDIF 
    158             IF( ln_trc_cbc(jn) )  THEN     
    159                clndta = TRIM( sn_trccbc(jn)%clvar )  
    160                IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, &  
    161                &               ' multiplicative factor : ', rn_trcfac(jn) 
    162             ENDIF 
    163          END DO 
    164       ENDIF 
    165       ! 
    166       ! The following code is written this way to reduce memory usage and repeated for each boundary data 
    167       ! MAV: note that this is just a placeholder and the dimensions must be changed according to  
    168       !      what will be done with BDY. A new structure will probably need to be included 
    169       ! 
     188         WRITE(numout,*) ' ' 
     189         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
     190         IF ( nb_trcsbc > 0 ) THEN 
     191            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     192            DO jn = 1, ntrc 
     193               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
     194            ENDDO 
     195         ENDIF 
     196         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
     197 
     198         WRITE(numout,*) ' ' 
     199         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
     200         IF ( nb_trccbc > 0 ) THEN 
     201            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     202            DO jn = 1, ntrc 
     203               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
     204            ENDDO 
     205         ENDIF 
     206         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     207 
     208         WRITE(numout,*) ' ' 
     209         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     210#if defined key_bdy 
     211         IF ( nb_trcobc > 0 ) THEN 
     212            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     213            DO jn = 1, ntrc 
     214               DO ib = 1, nb_bdy 
     215                 IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc) 
     216               ENDDO 
     217               !IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     218               IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     219            ENDDO 
     220            WRITE(numout,*) ' ' 
     221            DO ib = 1, nb_bdy 
     222                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     223                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     224                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     225                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     226                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     227                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     228                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
     229                ENDIF 
     230            ENDDO 
     231         ENDIF 
     232#endif 
     233         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     234      ENDIF 
     2359001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2369002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2379003  FORMAT(a, i5, a) 
     238 
     239      ! 
     240#if defined key_bdy 
    170241      ! OPEN Lateral boundary conditions 
    171       IF( nb_trcobc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    172          ALLOCATE( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 ) 
     242      IF( nb_trcobc > 0 ) THEN  
     243         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 
    173244         IF( ierr1 > 0 ) THEN 
    174             CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcobc structure' )   ;   RETURN 
    175          ENDIF 
    176          ! 
    177          DO jn = 1, ntrc 
    178             IF( ln_trc_obc(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    179                jl = n_trc_indobc(jn) 
    180                slf_i(jl)    = sn_trcobc(jn) 
    181                rf_trofac(jl) = rn_trofac(jn) 
    182                                             ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    183                IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    184                IF( ierr2 + ierr3 > 0 ) THEN 
    185                  CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     245            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     246         ENDIF 
     247 
     248         igrd = 1                       ! Everything is at T-points here 
     249 
     250         DO ib = 1, nb_bdy 
     251            DO jn = 1, ntrc 
     252 
     253               nblen = idx_bdy(ib)%nblen(igrd) 
     254 
     255               IF ( ln_trc_obc(jn) ) THEN 
     256               ! Initialise from external data 
     257                  jl = n_trc_indobc(jn) 
     258                  slf_i(jl)    = sn_trcobc(jn,ib) 
     259                  rf_trofac(jl,ib) = rn_trofac(jn) 
     260                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     261                  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 
     265                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 
     266                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 
     267                  ! create OBC mapping array 
     268                  nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     269                  nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd) 
     270               ELSE 
     271               ! Initialise obc arrays from initial conditions 
     272                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
     273                  DO ibd = 1, nblen 
     274                     DO ik = 1, jpkm1 
     275                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
     276                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
     277                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     278                     END DO 
     279                  END DO 
     280                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    186281               ENDIF 
    187             ENDIF 
    188             !    
     282            ENDDO 
     283            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    189284         ENDDO 
    190          !                         ! fill sf_trcdta with slf_i and control print 
    191          CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    192          ! 
    193       ENDIF 
    194       ! 
     285 
     286      ENDIF 
     287#endif 
    195288      ! SURFACE Boundary conditions 
    196289      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    … …  
    214307         ENDDO 
    215308         !                         ! fill sf_trcsbc with slf_i and control print 
    216          CALL fld_fill( sf_trcsbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
     309         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217310         ! 
    218311      ENDIF 
    … …  
    239332         ENDDO 
    240333         !                         ! fill sf_trccbc with slf_i and control print 
    241          CALL fld_fill( sf_trccbc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
     334         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242335         ! 
    243336      ENDIF 
    … …  
    249342 
    250343 
    251    SUBROUTINE trc_bc_read(kt) 
     344   SUBROUTINE trc_bc_read(kt, jit) 
    252345      !!---------------------------------------------------------------------- 
    253346      !!                   ***  ROUTINE trc_bc_init  *** 
    … …  
    264357      !! * Arguments 
    265358      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     359      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     360      INTEGER :: ib 
    267361      !!--------------------------------------------------------------------- 
    268362      ! 
    269363      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270364 
    271       IF( kt == nit000 ) THEN 
    272          IF(lwp) WRITE(numout,*) 
    273          IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
    274          IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    275       ENDIF 
    276  
    277       ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 
    278       IF( nb_trcobc > 0 ) THEN 
    279         if (lwp) write(numout,'(a,i5,a,i5)') '   reading OBC data for ', nb_trcobc ,' variables at step ', kt 
    280         CALL fld_read(kt,1,sf_trcobc) 
    281         ! vertical interpolation on s-grid and partial step to be added 
    282       ENDIF 
    283  
    284       ! SURFACE boundary conditions        
    285       IF( nb_trcsbc > 0 ) THEN 
    286         if (lwp) write(numout,'(a,i5,a,i5)') '   reading SBC data for ', nb_trcsbc ,' variables at step ', kt 
    287         CALL fld_read(kt,1,sf_trcsbc) 
    288       ENDIF 
    289  
    290       ! COASTAL boundary conditions        
    291       IF( nb_trccbc > 0 ) THEN 
    292         if (lwp) write(numout,'(a,i5,a,i5)') '   reading CBC data for ', nb_trccbc ,' variables at step ', kt 
    293         CALL fld_read(kt,1,sf_trccbc) 
    294       ENDIF    
     365      IF( kt == nit000 .AND. lwp) THEN 
     366         WRITE(numout,*) 
     367         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     368         WRITE(numout,*) '~~~~~~~~~~~ ' 
     369      ENDIF 
     370 
     371      IF ( PRESENT(jit) ) THEN  
     372 
     373#ifdef key_bdy 
     374         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     375         IF( nb_trcobc > 0 ) THEN 
     376           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     377           DO ib = 1,nb_bdy 
     378             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 
     379           ENDDO 
     380         ENDIF 
     381#endif 
     382 
     383         ! SURFACE boundary conditions 
     384         IF( nb_trcsbc > 0 ) THEN 
     385           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     386           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     387         ENDIF 
     388 
     389         ! COASTAL boundary conditions 
     390         IF( nb_trccbc > 0 ) THEN 
     391           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     392           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     393         ENDIF 
     394 
     395      ELSE 
     396 
     397#ifdef key_bdy 
     398         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     399         IF( nb_trcobc > 0 ) THEN 
     400           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     401           DO ib = 1,nb_bdy 
     402             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1) 
     403           ENDDO 
     404         ENDIF 
     405#endif 
     406 
     407         ! SURFACE boundary conditions 
     408         IF( nb_trcsbc > 0 ) THEN 
     409           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     410           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     411         ENDIF 
     412 
     413         ! COASTAL boundary conditions 
     414         IF( nb_trccbc > 0 ) THEN 
     415           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     416           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     417         ENDIF 
     418 
     419      ENDIF 
     420 
    295421      ! 
    296422      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    … …  
    303429   !!---------------------------------------------------------------------- 
    304430CONTAINS 
     431 
     432   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     433      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     434      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     435   END SUBROUTINE trc_bc_init 
     436 
    305437   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306438      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r7827 r7829  
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
    1010   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
     11   !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
    1112   !!---------------------------------------------------------------------- 
    1213#if  defined key_top  
    … …  
    7273      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
    7374      ! 
     75      IF( lwp ) THEN 
     76         WRITE(numout,*) ' ' 
     77         WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     78         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
     79      ENDIF 
     80      ! 
    7481      !  Initialisation 
    7582      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
    … …  
    7784      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    7885      IF( ierr0 > 0 ) THEN 
    79          CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     86         CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
    8087      ENDIF 
    8188      nb_trcdta      = 0 
    … …  
    97104      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    98105      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    99 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 
     106901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
    100107 
    101108      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    102109      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    103 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 
     110902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
    104111      IF(lwm) WRITE ( numont, namtrc_dta ) 
    105112 
    … …  
    109116               clndta = TRIM( sn_trcdta(jn)%clvar )  
    110117               clntrc = TRIM( ctrcnm   (jn)       )  
     118               if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 
    111119               zfact  = rn_trfac(jn) 
    112120               IF( clndta /=  clntrc ) THEN  
    113                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
    114                   &              'the variable name in the data file : '//clndta//   &  
    115                   &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     121                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     122                  &              'Input name of data file : '//TRIM(clndta)//   & 
     123                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    116124               ENDIF 
    117                WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
    118                &               ' multiplicative factor : ', zfact 
     125               WRITE(numout,*) ' ' 
     126               WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 
     127               &            jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 
    119128            ENDIF 
    120129         END DO 
    … …  
    124133         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    125134         IF( ierr1 > 0 ) THEN 
    126             CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     135            CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    127136         ENDIF 
    128137         ! 
    … …  
    135144               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    136145               IF( ierr2 + ierr3 > 0 ) THEN 
    137                  CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     146                 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
    138147               ENDIF 
    139148            ENDIF 
    … …  
    141150         ENDDO 
    142151         !                         ! fill sf_trcdta with slf_i and control print 
    143          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     152         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
    144153         ! 
    145154      ENDIF 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r7827 r7829  
    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 
    … …  
    3236   USE sbc_oce 
    3337   USE trcice          ! tracers in sea ice 
     38   USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions 
    3439  
    3540   IMPLICIT NONE 
    … …  
    6974      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    7075      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 <<<+++ 
    7180 
    7281      CALL top_alloc()              ! allocate TOP arrays 
    … …  
    101110      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    102111      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 <<<+++ 
    103115 
    104116      CALL trc_ice_ini                                 ! Tracers in sea ice 
    … …  
    110122      ENDIF 
    111123 
     124      ! Initialisation of tracers Initial Conditions 
    112125      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    113  
    114126 
    115127      IF( ln_rsttr ) THEN 
    … …  
    140152            CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
    141153        ENDIF 
    142         ! 
    143         trb(:,:,:,:) = trn(:,:,:,:) 
    144         !  
    145       ENDIF 
     154      ENDIF 
     155      ! --->>> FABM 
     156! Initialisation of tracers Boundary Conditions  - here so that you can use initial condition as boundary 
     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 <<<+++ 
    146168  
    147169      tra(:,:,:,:) = 0._wp 
    … …  
    158180      trai(:) = 0._wp                                                   ! initial content of all tracers 
    159181      DO jn = 1, jptra 
    160          trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     182         !trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     183         trai(jn) = trai(jn) 
    161184      END DO 
    162185 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r7827 r7829  
    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 
    … …  
    3437   PUBLIC trc_nam_run  ! called in trcini 
    3538   PUBLIC trc_nam      ! called in trcini 
     39   PUBLIC trc_nam_dia 
     40#if defined key_trdmxl_trc  || defined key_trdtrc 
     41   NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     42      &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
     43      &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     44#endif 
    3645 
    3746   !! * Substitutions 
    … …  
    5766      !!--------------------------------------------------------------------- 
    5867      INTEGER  ::   jn                  ! dummy loop indice 
     68#if defined key_trdmxl_trc  || defined key_trdtrc 
     69      INTEGER :: ios 
     70#endif 
     71 
    5972      !                                        !   Parameters of the run  
    6073      IF( .NOT. lk_offline ) CALL trc_nam_run 
    … …  
    168181      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    169182      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 <<<+++ 
    170189      ! 
    171190   END SUBROUTINE trc_nam 
    … …  
    187206 
    188207 
    189       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     208      IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 
    190209      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    191210 
    … …  
    234253 
    235254      ! --- Namelist declarations --- ! 
    236       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 <<<+++  
    237261      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    238262 
    … …  
    278302      !! 
    279303      !!--------------------------------------------------------------------- 
    280       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    281       !! 
    282       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 
    283312   
    284313      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    … …  
    286315      !!--------------------------------------------------------------------- 
    287316      IF(lwp) WRITE(numout,*) 
    288       IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
     317      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    289318      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    290319 
     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 
    291328 
    292329      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    … …  
    304341         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    305342         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     343! --->>> FABM 
     344!!#if defined key_my_trc 
     345! FABM <<<--- 
     346! +++>>> FABM 
     347#if defined key_fabm 
     348! FABM <<<+++ 
     349         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
     350         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     351         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     352#endif 
    306353         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    307354      END DO 
    308        
     355      
     356      ! +++>>> FABM 
     357      if (lk_fabm) CALL trc_nam_fabm_override 
     358      ! FABM <<<+++ 
    309359    END SUBROUTINE trc_nam_trc 
    310360 
    … …  
    322372      INTEGER ::  ierr 
    323373#if defined key_trdmxl_trc  || defined key_trdtrc 
    324       NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    325          &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
    326          &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     374!     NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
     375!        &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
     376!        &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    327377#endif 
    328378      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    … …  
    330380      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    331381      !!--------------------------------------------------------------------- 
    332  
    333       IF(lwp) WRITE(numout,*)  
    334       IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
    335       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    336382 
    337383      IF(lwp) WRITE(numout,*) 
    … …  
    397443   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    398444   !!====================================================================== 
    399 END MODULE  trcnam 
     445END MODULE trcnam 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7827 r7829  
    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/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r7827 r7829  
    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) 
    … …  
    7581 
    7682   !!====================================================================== 
    77 END MODULE  trcsms 
     83END MODULE trcsms 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r7827 r7829  
    3232   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step 
    3333   REAL(wp) :: rdt_sampl 
    34    INTEGER  :: nb_rec_per_days 
     34   INTEGER  :: nb_rec_per_day 
    3535   INTEGER  :: isecfst, iseclast 
    3636   LOGICAL  :: llnew 
    … …  
    100100         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
    101101         IF( lk_trdmxl_trc  )      CALL trd_mxl_trc  ( kt )       ! trends: Mixed-layer 
     102#if defined key_tracer_budget 
     103!slwa tracer budget 
     104         IF( lk_iomput ) CALL trc_wri (kt, 2)  
     105#endif 
    102106         ! 
    103107         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    … …  
    123127      !!               of diurnal cycle 
    124128      !! 
    125       !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter  
     129      !! ** Method  : store in TOP the qsr every hour ( or every time-step if the latter  
    126130      !!              is greater than 1 hour ) and then, compute the  mean with  
    127131      !!              a moving average over 24 hours.  
    … …  
    134138         IF( ln_cpl )  THEN   
    135139            rdt_sampl = 86400. / ncpl_qsr_freq 
    136             nb_rec_per_days = ncpl_qsr_freq 
     140            nb_rec_per_day = ncpl_qsr_freq 
    137141         ELSE   
    138142            rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 
    139             nb_rec_per_days = INT( 86400 / rdt_sampl ) 
     143            nb_rec_per_day = INT( 86400 / rdt_sampl ) 
    140144         ENDIF 
    141145         ! 
    142146         IF( lwp ) THEN 
    143147            WRITE(numout,*)  
    144             WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days 
     148            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_day 
    145149            WRITE(numout,*)  
    146150         ENDIF 
    147151         ! 
    148          ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 
    149          DO jn = 1, nb_rec_per_days 
    150             qsr_arr(:,:,jn) = qsr(:,:) 
     152         !                                            !* Restart: read in restart file 
     153         IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN  
     154            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file' 
     155            CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr 
     156         ELSE                                         !* no restart: set from nit000 values 
     157            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean set to nit000 values' 
     158            qsr_mean(:,:) = qsr(:,:) 
     159         ENDIF 
     160         ! 
     161         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 
     162         DO jn = 1, nb_rec_per_day 
     163             qsr_arr(:,:,jn) = qsr_mean(:,:) 
    151164         ENDDO 
    152          qsr_mean(:,:) = qsr(:,:) 
    153165         ! 
    154166         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
    … …  
    163175             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 
    164176          isecfst = iseclast 
    165           DO jn = 1, nb_rec_per_days - 1 
     177          DO jn = 1, nb_rec_per_day - 1 
    166178             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 
    167179          ENDDO 
    168           qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 
    169           qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 
    170       ENDIF 
    171       ! 
     180          qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 
     181          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 
     182      ENDIF 
     183      ! 
     184      IF( lrst_trc ) THEN    !* Write the mean of qsr in restart file  
     185         IF(lwp) WRITE(numout,*) 
     186         IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file  kt =', kt 
     187         IF(lwp) WRITE(numout,*) '~~~~~~~' 
     188         CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 
     189      ENDIF 
     190     ! 
    172191   END SUBROUTINE trc_mean_qsr 
    173192 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r7827 r7829  
    2020#endif 
    2121#if defined key_zdfgls 
    22    USE zdfgls, ONLY: en 
     22!  USE zdfgls, ONLY: en 
    2323#endif 
    2424   USE trabbl 

  • branches/UKMO/dev_r5518_nemo_fabm_ukmo/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r7827 r7829  
    2121   USE trcwri_c14b 
    2222   USE trcwri_my_trc 
     23   ! +++>>> FABM 
     24   USE trcwri_fabm 
     25   ! FABM <<<+++ 
    2326 
    2427   IMPLICIT NONE 
    … …  
    3235CONTAINS 
    3336 
     37#if defined key_tracer_budget 
     38   SUBROUTINE trc_wri( kt , fl)  !slwa 
     39#else 
    3440   SUBROUTINE trc_wri( kt ) 
     41#endif 
    3542      !!--------------------------------------------------------------------- 
    3643      !!                     ***  ROUTINE trc_wri  *** 
    … …  
    3946      !!--------------------------------------------------------------------- 
    4047      INTEGER, INTENT( in )     :: kt 
     48#if defined key_tracer_budget 
     49      INTEGER, INTENT( in ), OPTIONAL     :: fl  ! slwa 
     50#endif 
    4151      ! 
    4252      INTEGER                   :: jn 
    … …  
    5969      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6070      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     71#if defined key_tracer_budget 
     72      IF( .NOT.PRESENT(fl) .AND. lk_my_trc  )   CALL trc_wri_my_trc (kt)     ! MY_TRC  tracers   slwa 
     73      IF( PRESENT(fl) .AND. lk_my_trc  )   CALL trc_wri_my_trc (kt, fl)    ! MY_TRC  tracers for budget slwa 
     74#else 
    6175      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     76#endif 
     77      ! +++>>>FABM 
     78      IF( lk_fabm    )   CALL trc_wri_fabm      ! FABM tracers 
     79      ! FABM <<<+++ 
    6280      ! 
    6381      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.