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 10156 for branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2018-09-25T13:10:14+02:00 (6 years ago)
Author:
dford
Message:

Apply patch fabm_patch_e3284ca_889163b.diff from Jim Clark.

Location:
branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC
Files:
10 added
19 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r8058 r10156  
    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#else 
     44      INTEGER, INTENT( in )               :: kt 
     45#endif 
    3146      CHARACTER (len=20)   :: cltra 
    32       INTEGER              :: jn 
     47      INTEGER              :: jn,jk ! JC TODO jk defined here but may not be used 
    3348      !!--------------------------------------------------------------------- 
    3449  
    3550      ! write the tracer concentrations in the file 
    3651      ! --------------------------------------- 
     52 
     53 
     54#if defined key_tracer_budget 
     55      IF( PRESENT(fl)) THEN 
     56! depth integrated 
     57! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 
     58         DO jn = jp_myt0, jp_myt1  
     59          IF(ln_trdtrc (jn))THEN 
     60            trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) +  & 
     61                                        trb_temp(:,:,:,jn) * fse3t(:,:,:) ) 
     62            cltra = TRIM( ctrcnm(jn) )//"e3t"     ! depth integrated output 
     63            IF( kt == nittrc000 ) write(6,*)'output pool ',cltra 
     64            DO jk = 1, jpk 
     65               trpool(:,:,jk) = trpool(:,:,jk) 
     66            END DO 
     67            CALL iom_put( cltra, trpool) 
     68 
     69          END IF 
     70         END DO 
     71 
     72      ELSE 
     73 
     74         IF( kt == nittrc000 ) THEN 
     75           ALLOCATE(trb_temp(jpi,jpj,jpk,jp_my_trc))  ! slwa 
     76         ENDIF 
     77         trb_temp(:,:,:,:)=trn(:,:,:,:) ! slwa save for tracer budget (unfiltered trn) 
     78 
     79 
     80      END IF 
     81#else 
    3782      DO jn = jp_myt0, jp_myt1 
    3883         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    3984         CALL iom_put( cltra, trn(:,:,:,jn) ) 
    4085      END DO 
     86#endif 
    4187      ! 
    4288   END SUBROUTINE trc_wri_my_trc 
     
    4894   PUBLIC trc_wri_my_trc 
    4995CONTAINS 
    50    SUBROUTINE trc_wri_my_trc                     ! Empty routine   
     96#if defined key_tracer_budget 
     97   SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa 
     98      INTEGER, INTENT( in ), OPTIONAL     :: fl  
     99      INTEGER, INTENT( in )               :: kt 
     100#else 
     101   ! JC TODO Subroutine arguments (kt) inconsistent with earlier definition 
     102   SUBROUTINE trc_wri_my_trc (kt) 
     103      INTEGER, INTENT( in )               :: kt 
     104#endif 
    51105   END SUBROUTINE trc_wri_my_trc 
    52106#endif 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r8058 r10156  
    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 
     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 
    103124 
    104125#if defined key_agrif 
     
    111132 
    112133 
    113 #if defined key_bdy 
    114 !!      CALL bdy_trc( kt )               ! BDY open 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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r8058 r10156  
    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         IF (.not. ALLOCATED(ztrtrdb_m1)) ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     138            DO jn = jp_sms0, jp_sms1 
     139               IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     140                  iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(jn)), ldstop = .FALSE. ) > 0 ) THEN 
     141                  IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc RDB tracer trend read for',TRIM(ctrcnm(jn)) 
     142                  CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )   ! before tracer trend for rdb 
     143               ELSE 
     144                  IF(lwp) WRITE(numout,*) '          no nittrc000-nn_dttrc RDB tracer trend for',TRIM(ctrcnm(jn)),', setting to 0.' 
     145                  ztrtrdb_m1(:,:,:,jn)=0.0 
     146               ENDIF 
     147            END DO 
     148      ENDIF 
     149#endif 
    118150       
    119151      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
     
    156188               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    157189               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     190#if defined key_tracer_budget 
     191! slwa budget code 
     192               DO jk = 1, jpkm1 
     193                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     194                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     195               END DO 
     196               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     197               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     198#else 
    158199               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     200#endif 
    159201               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    160202              ! 
     
    187229               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    188230               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     231#if defined key_tracer_budget 
     232! slwa budget code 
     233               DO jk = 1, jpkm1 
     234                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     235                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     236               END DO 
     237               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     238               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     239#else 
    189240               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     241#endif 
    190242               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    191243              ! 
     
    195247 
    196248      ENDIF 
     249 
     250#if defined key_tracer_budget 
     251      !                                           Write in the tracer restart file 
     252      !                                          ******************************* 
     253      IF( lrst_trc ) THEN 
     254         IF(lwp) WRITE(numout,*) 
     255         IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ',   & 
     256            &                    'at it= ', kt,' date= ', ndastp 
     257         IF(lwp) WRITE(numout,*) '~~~~' 
     258         DO jn = jp_sms0, jp_sms1 
     259            CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) 
     260         END DO 
     261      ENDIF 
     262#endif 
    197263 
    198264      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90

    r8058 r10156  
    102102         END SELECT 
    103103                                          cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 
     104         ! +++>>>FABM 
     105#if defined key_tracer_budget 
     106! for outputting depth integrated 
     107         SELECT CASE( ktrd ) 
     108         CASE( jptra_xad, jptra_yad, jptra_zad  )  
     109           cltra = TRIM(cltra)//"_e3t" 
     110         END SELECT 
     111#endif 
     112         ! FABM <<<+++ 
    104113                                          CALL iom_put( cltra,  ptrtrd(:,:,:) ) 
    105114         ! 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r8058 r10156  
    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      ntra_obc = MAX( 1, nb_trcobc )   ! To avoid compilation error with bounds checking 
     186      IF( lwp ) WRITE(numout,*) ' ' 
     187      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 
     188      IF( lwp ) WRITE(numout,*) ' ' 
     189      ntra_sbc = MAX( 1, nb_trcsbc )   ! To avoid compilation error with bounds checking 
     190      IF( lwp ) WRITE(numout,*) ' ' 
     191      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 
     192      IF( lwp ) WRITE(numout,*) ' ' 
     193      ntra_cbc = MAX( 1, nb_trccbc )   ! To avoid compilation error with bounds checking 
     194      IF( lwp ) WRITE(numout,*) ' ' 
     195      IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 
     196      IF( lwp ) WRITE(numout,*) ' ' 
     197 
     198      ! Print summmary of Boundary Conditions 
    146199      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       ! 
     200         WRITE(numout,*) ' ' 
     201         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 
     202         IF ( nb_trcsbc > 0 ) THEN 
     203            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     204            DO jn = 1, ntrc 
     205               IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 
     206            ENDDO 
     207         ENDIF 
     208         WRITE(numout,'(2a)') '   SURFACE BC data repository : ', TRIM(cn_dir_sbc) 
     209 
     210         WRITE(numout,*) ' ' 
     211         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
     212         IF ( nb_trccbc > 0 ) THEN 
     213            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
     214            DO jn = 1, ntrc 
     215               IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 
     216            ENDDO 
     217         ENDIF 
     218         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
     219 
     220         WRITE(numout,*) ' ' 
     221         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
     222#if defined key_bdy 
     223         IF ( nb_trcobc > 0 ) THEN 
     224            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
     225            DO jn = 1, ntrc 
     226               DO ib = 1, nb_bdy 
     227                 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) 
     228               ENDDO 
     229               !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) 
     230               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) 
     231            ENDDO 
     232            WRITE(numout,*) ' ' 
     233            DO ib = 1, nb_bdy 
     234                IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     235                IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     236                IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     237                IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     238                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
     239                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
     240                   WRITE(numout,'(a,f10.2,a)') '     - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 
     241                ENDIF 
     242            ENDDO 
     243         ENDIF 
     244#endif 
     245         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
     246      ENDIF 
     2479001  FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 
     2489002  FORMAT(2x,i5, 3x, a41, 3x, 10a13) 
     2499003  FORMAT(a, i5, a) 
     250 
     251      ! 
     252#if defined key_bdy 
    170253      ! 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 ) 
     254      IF( nb_trcobc > 0 ) THEN  
     255         ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 
    173256         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 
     257            CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     258         ENDIF 
     259 
     260         igrd = 1                       ! Everything is at T-points here 
     261 
     262         DO ib = 1, nb_bdy 
     263            DO jn = 1, ntrc 
     264 
     265               nblen = idx_bdy(ib)%nblen(igrd) 
     266 
     267               IF ( ln_trc_obc(jn) ) THEN 
     268               ! Initialise from external data 
     269                  jl = n_trc_indobc(jn) 
     270                  slf_i(jl)    = sn_trcobc(jn,ib) 
     271                  rf_trofac(jl,ib) = rn_trofac(jn) 
     272                                               ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk)   , STAT=ierr2 ) 
     273                  IF( sn_trcobc(jn,ib)%ln_tint )  ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
     274                  IF( ierr2 + ierr3 > 0 ) THEN 
     275                    CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     276                  ENDIF 
     277                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 
     278                  trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 
     279                  ! create OBC mapping array 
     280                  nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd) 
     281                  nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd) 
     282               ELSE 
     283               ! Initialise obc arrays from initial conditions 
     284                  ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 
     285                  DO ibd = 1, nblen 
     286                     DO ik = 1, jpkm1 
     287                        ii = idx_bdy(ib)%nbi(ibd,igrd) 
     288                        ij = idx_bdy(ib)%nbj(ibd,igrd) 
     289                        trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 
     290                     END DO 
     291                  END DO 
     292                  trcdta_bdy(jn,ib)%rn_fac = 1._wp 
    186293               ENDIF 
    187             ENDIF 
    188             !    
     294            ENDDO 
     295            CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    189296         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       ! 
     297 
     298      ENDIF 
     299#endif 
    195300      ! SURFACE Boundary conditions 
    196301      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
     
    214319         ENDDO 
    215320         !                         ! 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' ) 
     321         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
    217322         ! 
    218323      ENDIF 
     
    239344         ENDDO 
    240345         !                         ! 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' ) 
     346         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
    242347         ! 
    243348      ENDIF 
     
    249354 
    250355 
    251    SUBROUTINE trc_bc_read(kt) 
     356   SUBROUTINE trc_bc_read(kt, jit) 
    252357      !!---------------------------------------------------------------------- 
    253358      !!                   ***  ROUTINE trc_bc_init  *** 
     
    264369      !! * Arguments 
    265370      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    266  
     371      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     372      INTEGER :: ib 
    267373      !!--------------------------------------------------------------------- 
    268374      ! 
    269375      IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
    270376 
    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) 
     377      IF( kt == nit000 .AND. lwp) THEN 
     378         WRITE(numout,*) 
     379         WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     380         WRITE(numout,*) '~~~~~~~~~~~ ' 
     381      ENDIF 
     382 
     383      IF ( PRESENT(jit) ) THEN  
     384 
     385#ifdef key_bdy 
     386         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     387         IF( nb_trcobc > 0 ) THEN 
     388           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     389           DO ib = 1,nb_bdy 
     390             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 
     391           ENDDO 
     392         ENDIF 
     393#endif 
     394 
     395         ! SURFACE boundary conditions 
     396         IF( nb_trcsbc > 0 ) THEN 
     397           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     398           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 
     399         ENDIF 
     400 
     401         ! COASTAL boundary conditions 
     402         IF( nb_trccbc > 0 ) THEN 
     403           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     404           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 
     405         ENDIF 
     406 
     407      ELSE 
     408 
     409#ifdef key_bdy 
     410         ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 
     411         IF( nb_trcobc > 0 ) THEN 
     412           if (lwp) write(numout,'(a,i5,a,i10)') '   reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 
     413           DO ib = 1,nb_bdy 
     414             CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1) 
     415           ENDDO 
     416         ENDIF 
     417#endif 
     418 
     419         ! SURFACE boundary conditions 
     420         IF( nb_trcsbc > 0 ) THEN 
     421           if (lwp) write(numout,'(a,i5,a,i10)') '   reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 
     422           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 
     423         ENDIF 
     424 
     425         ! COASTAL boundary conditions 
     426         IF( nb_trccbc > 0 ) THEN 
     427           if (lwp) write(numout,'(a,i5,a,i10)') '   reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 
     428           CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 
     429         ENDIF 
     430 
    288431      ENDIF 
    289432 
     
    303446   !!---------------------------------------------------------------------- 
    304447CONTAINS 
     448 
     449   SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     450      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
     451      WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
     452   END SUBROUTINE trc_bc_init 
     453 
    305454   SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    306455      WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r8058 r10156  
    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) 
    113126 
     
    144157        !  
    145158      ENDIF 
     159      ! --->>> FABM 
     160! Initialisation of tracers Boundary Conditions  - here so that you can use initial condition as boundary 
     161      !IF( lk_my_trc )     CALL trc_bc_init(jptra) 
     162      ! FABM <<<--- 
     163      ! FABM +++>>> 
     164! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary) 
     165      IF( lk_fabm )     THEN 
     166          wndm=0._wp !uninitiased field at this point 
     167          qsr=0._wp !uninitiased field at this point 
     168          CALL compute_fabm ! only needed to set-up diagnostics 
     169          CALL trc_bc_init(jptra) 
     170      ENDIF 
     171      ! FABM <<<+++ 
    146172  
    147173      tra(:,:,:,:) = 0._wp 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r8058 r10156  
    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 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r8058 r10156  
    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/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r8058 r10156  
    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 
  • branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r8058 r10156  
    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      ! +++>>>FABM 
     49#if defined key_tracer_budget 
     50      INTEGER, INTENT( in ), OPTIONAL     :: fl  ! slwa 
     51#endif 
     52      ! FABM <<<+++ 
    4153      ! 
    4254      INTEGER                   :: jn 
     
    5971      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6072      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
    61       IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     73      ! +++>>>FABM 
     74#if defined key_tracer_budget 
     75      IF( PRESENT(fl) ) THEN 
     76         IF( lk_fabm    )   CALL trc_wri_fabm (kt, fl) ! MY_TRC  tracers for budget 
     77         IF( lk_my_trc ) CALL trc_wri_my_trc (kt, fl)    ! MY_TRC  tracers for budget 
     78      ELSE 
     79         IF( lk_fabm    )   CALL trc_wri_fabm (kt) ! FABM  tracers for budget 
     80         IF( lk_my_trc  )   CALL trc_wri_my_trc (kt) ! MY_TRC  tracers 
     81      ENDIF 
     82#else 
     83      IF( lk_fabm  )   CALL trc_wri_fabm (kt)     ! FABM  tracers 
     84      IF( lk_my_trc  )   CALL trc_wri_my_trc(kt)     ! MY_TRC  tracers 
     85#endif 
     86      ! FABM <<<+++ 
    6287      ! 
     88 
    6389      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
    6490      ! 
Note: See TracChangeset for help on using the changeset viewer.