Changeset 10850


Ignore:
Timestamp:
2019-04-08T15:00:20+02:00 (20 months ago)
Author:
kingr
Message:

Merged updates from AMM15_v3_6_STABLE_package_collate

Location:
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM
Files:
15 edited
5 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/CONFIG/SHARED/namelist_ref

    r10479 r10850  
    12811281&nam_asminc   !   assimilation increments                               ('key_asminc') 
    12821282!----------------------------------------------------------------------- 
    1283     ln_bkgwri = .false.    !  Logical switch for writing out background state 
    1284     ln_trainc = .false.    !  Logical switch for applying tracer increments 
    1285     ln_dyninc = .false.    !  Logical switch for applying velocity increments 
    1286     ln_sshinc = .false.    !  Logical switch for applying SSH increments 
    1287     ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI) 
    1288     ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU) 
    1289     nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1] 
    1290     nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1] 
    1291     nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1] 
    1292     nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
    1293     niaufn    = 0          !  Type of IAU weighting function 
    1294     ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin 
    1295     salfixmin = -9999      !  Minimum salinity after applying the increments 
    1296     nn_divdmp = 0          !  Number of iterations of divergence damping operator 
     1283    ln_bkgwri      = .false. !  Logical switch for writing out background state 
     1284    ln_balwri      = .false. !  Logical switch for writing out balancing increments 
     1285    ln_trainc      = .false. !  Logical switch for applying tracer increments 
     1286    ln_dyninc      = .false. !  Logical switch for applying velocity increments 
     1287    ln_sshinc      = .false. !  Logical switch for applying SSH increments 
     1288    ln_asmdin      = .false. !  Logical switch for Direct Initialization (DI) 
     1289    ln_asmiau      = .false. !  Logical switch for Incremental Analysis Updating (IAU) 
     1290    ln_phytobal    = .false. !  Logical switch for phytoplankton multivariate balancing 
     1291    ln_slchltotinc = .false. !  Logical switch for applying slchltot increments 
     1292    ln_slchldiainc = .false. !  Logical switch for applying slchldia increments 
     1293    ln_slchlnoninc = .false. !  Logical switch for applying slchlnon increments 
     1294    ln_slchlnaninc = .false. !  Logical switch for applying slchlnan increments 
     1295    ln_slchlpicinc = .false. !  Logical switch for applying slchlpic increments 
     1296    ln_slchldininc = .false. !  Logical switch for applying slchldin increments 
     1297    ln_schltotinc  = .false. !  Logical switch for applying schltot increments 
     1298    ln_slphytotinc = .false. !  Logical switch for applying slphytot increments 
     1299    ln_slphydiainc = .false. !  Logical switch for applying slphydia increments 
     1300    ln_slphynoninc = .false. !  Logical switch for applying slphynon increments 
     1301    ln_sfco2inc    = .false. !  Logical switch for applying sfCO2 increments 
     1302    ln_spco2inc    = .false. !  Logical switch for applying spCO2 increments 
     1303    ln_plchltotinc = .false. !  Logical switch for applying plchltot increments 
     1304    ln_pchltotinc  = .false. !  Logical switch for applying pchltot increments 
     1305    ln_pno3inc     = .false. !  Logical switch for applying pno3 increments 
     1306    ln_psi4inc     = .false. !  Logical switch for applying psi4 increments 
     1307    ln_ppo4inc     = .false. !  Logical switch for applying ppo4 increments 
     1308    ln_pdicinc     = .false. !  Logical switch for applying pdic increments 
     1309    ln_palkinc     = .false. !  Logical switch for applying palk increments 
     1310    ln_pphinc      = .false. !  Logical switch for applying pph increments 
     1311    ln_po2inc      = .false. !  Logical switch for applying po2 increments 
     1312    nitbkg         = 0       !  Timestep of background in [0,nitend-nit000-1] 
     1313    nitdin         = 0       !  Timestep of background for DI in [0,nitend-nit000-1] 
     1314    nitiaustr      = 1       !  Timestep of start of IAU interval in [0,nitend-nit000-1] 
     1315    nitiaufin      = 15      !  Timestep of end of IAU interval in [0,nitend-nit000-1] 
     1316    niaufn         = 0       !  Type of IAU weighting function 
     1317    ln_salfix      = .false. !  Logical switch for ensuring that the sa > salfixmin 
     1318    salfixmin      = -9999   !  Minimum salinity after applying the increments 
     1319    nn_divdmp      = 0       !  Number of iterations of divergence damping operator 
     1320    mld_choice_bgc = 1       !  MLD criterion to use for biogeochemistry assimilation 
     1321    rn_maxchlinc   = -999.0  !  maximum absolute non-log chlorophyll increment from ocean colour assimilation 
     1322                             !  <= 0 implies no maximum applied (switch turned off) 
     1323                             !   > 0 implies maximum absolute chl increment capped at this value 
    12971324/ 
    12981325!----------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90

    r9180 r10850  
    5151#endif 
    5252   USE asminc, ONLY: ln_avgbkg 
     53#if defined key_top 
     54   USE asmbgc, ONLY: asm_bgc_bkg_alloc, & 
     55      &              asm_bgc_bkg_tavg,  & 
     56      &              asm_bgc_bkg_wri 
     57#endif 
    5358   IMPLICIT NONE 
    5459   PRIVATE 
     
    137142          
    138143         numtimes_tavg = REAL ( nitavgbkg_r -  nn_it000 + 1 ) 
    139       ENDIF    
     144      ENDIF 
     145       
     146#if defined key_top 
     147      ! Allocate BGC average arrays whatever, to save code repetition later 
     148      IF ( kt == ( nn_it000 - 1) ) THEN 
     149         CALL asm_bgc_bkg_alloc 
     150      ENDIF 
     151#endif 
    140152 
    141153      ! If creating an averaged assim bkg, sum the contribution every timestep 
     
    154166#if defined key_zdftke 
    155167         en_tavg(:,:,:)       = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 
     168#endif 
     169#if defined key_top 
     170         CALL asm_bgc_bkg_tavg( kt, numtimes_tavg ) 
    156171#endif 
    157172      ENDIF 
     
    222237            ENDIF 
    223238             
     239#if defined key_top 
     240            CALL asm_bgc_bkg_wri( kt, inum, ln_avgbkg ) 
     241#endif 
    224242            CALL iom_close( inum ) 
    225243 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r9537 r10850  
    5252   USE bdy_oce, ONLY: bdytmask   
    5353#endif   
     54   USE asmbgc           ! Biogeochemistry assimilation 
    5455 
    5556   IMPLICIT NONE 
     
    6263   PUBLIC   ssh_asm_inc    !: Apply the SSH increment 
    6364   PUBLIC   seaice_asm_inc !: Apply the seaice increment 
     65   PUBLIC   bgc_asm_inc    !: Apply the biogeochemistry increments 
    6466 
    6567#if defined key_asminc 
     
    7678   LOGICAL, PUBLIC :: ln_sshinc = .FALSE.      !: No sea surface height assimilation increment 
    7779   LOGICAL, PUBLIC :: ln_seaiceinc             !: No sea ice concentration increment 
     80   LOGICAL, PUBLIC :: lk_bgcinc = .FALSE.      !: No biogeochemistry increments 
    7881   LOGICAL, PUBLIC :: ln_salfix = .FALSE.      !: Apply minimum salinity check 
    7982   LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing 
     
    161164                               !               so only apply surft increments. 
    162165      !! 
    163       NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg,                           & 
     166      NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg, ln_balwri,                & 
    164167         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
     168         &                 ln_phytobal, ln_slchltotinc, ln_slchldiainc,    & 
     169         &                 ln_slchlnaninc, ln_slchlpicinc, ln_slchldininc, & 
     170         &                 ln_slchlnoninc, ln_schltotinc, ln_slphytotinc,  & 
     171         &                 ln_slphydiainc, ln_slphynoninc, ln_spco2inc,    & 
     172         &                 ln_sfco2inc, ln_plchltotinc, ln_pchltotinc,     & 
     173         &                 ln_pno3inc, ln_psi4inc, ln_pdicinc, ln_palkinc, & 
     174         &                 ln_pphinc, ln_po2inc, ln_ppo4inc,               & 
    165175         &                 ln_asmdin, ln_asmiau,                           & 
    166176         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
    167          &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice 
     177         &                 ln_salfix, salfixmin, nn_divdmp, nitavgbkg,     & 
     178         &                 mld_choice, mld_choice_bgc, rn_maxchlinc 
    168179      !!---------------------------------------------------------------------- 
    169180 
     
    205216         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 
    206217         WRITE(numout,*) '~~~~~~~~~~~~' 
    207          WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
     218         WRITE(numout,*) '   Namelist nam_asminc : set assimilation increment parameters' 
    208219         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
    209220         WRITE(numout,*) '      Logical switch for writing mean background state         ln_avgbkg = ', ln_avgbkg 
     221         WRITE(numout,*) '      Logical switch for writing out balancing increments      ln_balwri = ', ln_balwri 
    210222         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
    211223         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     
    213225         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin 
    214226         WRITE(numout,*) '      Logical switch for applying sea ice increments        ln_seaiceinc = ', ln_seaiceinc 
     227         WRITE(numout,*) '      Logical switch for phytoplankton balancing             ln_phytobal = ', ln_phytobal 
     228         WRITE(numout,*) '      Logical switch for applying slchltot increments     ln_slchltotinc = ', ln_slchltotinc 
     229         WRITE(numout,*) '      Logical switch for applying slchldia increments     ln_slchldiainc = ', ln_slchldiainc 
     230         WRITE(numout,*) '      Logical switch for applying slchlnon increments     ln_slchlnoninc = ', ln_slchlnoninc 
     231         WRITE(numout,*) '      Logical switch for applying slchlnan increments     ln_slchlnaninc = ', ln_slchlnaninc 
     232         WRITE(numout,*) '      Logical switch for applying slchlpic increments     ln_slchlpicinc = ', ln_slchlpicinc 
     233         WRITE(numout,*) '      Logical switch for applying slchldin increments     ln_slchldininc = ', ln_slchldininc 
     234         WRITE(numout,*) '      Logical switch for applying schltot increments       ln_schltotinc = ', ln_schltotinc 
     235         WRITE(numout,*) '      Logical switch for applying slphytot increments     ln_slphytotinc = ', ln_slphytotinc 
     236         WRITE(numout,*) '      Logical switch for applying slphydia increments     ln_slphydiainc = ', ln_slphydiainc 
     237         WRITE(numout,*) '      Logical switch for applying slphynon increments     ln_slphynoninc = ', ln_slphynoninc 
     238         WRITE(numout,*) '      Logical switch for applying spco2 increments           ln_spco2inc = ', ln_spco2inc 
     239         WRITE(numout,*) '      Logical switch for applying sfco2 increments           ln_sfco2inc = ', ln_sfco2inc 
     240         WRITE(numout,*) '      Logical switch for applying plchltot increments     ln_plchltotinc = ', ln_plchltotinc 
     241         WRITE(numout,*) '      Logical switch for applying pchltot increments       ln_pchltotinc = ', ln_pchltotinc 
     242         WRITE(numout,*) '      Logical switch for applying pno3 increments             ln_pno3inc = ', ln_pno3inc 
     243         WRITE(numout,*) '      Logical switch for applying psi4 increments             ln_psi4inc = ', ln_psi4inc 
     244         WRITE(numout,*) '      Logical switch for applying ppo4 increments             ln_ppo4inc = ', ln_ppo4inc 
     245         WRITE(numout,*) '      Logical switch for applying pdic increments             ln_pdicinc = ', ln_pdicinc 
     246         WRITE(numout,*) '      Logical switch for applying palk increments             ln_palkinc = ', ln_palkinc 
     247         WRITE(numout,*) '      Logical switch for applying pph increments               ln_pphinc = ', ln_pphinc 
     248         WRITE(numout,*) '      Logical switch for applying po2 increments               ln_po2inc = ', ln_po2inc 
    215249         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau 
    216250         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg 
     
    223257         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin 
    224258         WRITE(numout,*) '      Choice of MLD for physics assimilation                  mld_choice = ', mld_choice 
     259         WRITE(numout,*) '      Choice of MLD for BGC assimilation                  mld_choice_bgc = ', mld_choice_bgc 
     260         WRITE(numout,*) '      Maximum absolute chlorophyll increment (<=0 = off)    rn_maxchlinc = ', rn_maxchlinc 
    225261      ENDIF 
    226262 
     
    263299         WRITE(numout,*) '       iitavgbkg_date = ', iitavgbkg_date 
    264300      ENDIF 
     301      IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 
     302         & ln_slchlnaninc .OR. ln_slchlpicinc .OR. ln_slchldininc .OR. & 
     303         & ln_schltotinc  .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 
     304         & ln_slphynoninc .OR. ln_spco2inc    .OR. ln_sfco2inc    .OR. & 
     305         & ln_plchltotinc .OR. ln_pchltotinc  .OR. ln_pno3inc     .OR. & 
     306         & ln_psi4inc     .OR. ln_pdicinc     .OR. ln_palkinc     .OR. & 
     307         & ln_pphinc      .OR. ln_po2inc      .OR. ln_ppo4inc ) THEN 
     308         lk_bgcinc = .TRUE. 
     309      ENDIF 
    265310 
    266311      IF ( nacc /= 0 ) & 
     
    274319 
    275320      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) & 
    276            .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) .OR. ( ln_seaiceinc) )) & 
    277          & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc is set to .true.', & 
     321         & .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ).OR. & 
     322         &        ( lk_bgcinc ) )) & 
     323         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 
     324         &                ' ln_(bgc-variable)inc is set to .true.', & 
    278325         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', & 
    279326         &                ' Inconsistent options') 
     
    284331 
    285332      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ).AND.( .NOT. ln_seaiceinc ) & 
    286          &                     )  & 
    287          & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc are set to .false. :', & 
     333         & .AND.( .NOT. lk_bgcinc ) )  & 
     334         & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 
     335         &                ' ln_(bgc-variable)inc are set to .false. :', & 
    288336         &                ' The assimilation increments are not applied') 
    289337 
     
    310358         &                ' Assim bkg averaging period is outside', & 
    311359         &                ' the cycle interval') 
     360       
     361      IF ( lk_bgcinc ) CALL asm_bgc_check_options 
    312362 
    313363      IF ( nstop > 0 ) RETURN       ! if there are any errors then go no further 
     
    412462      ssh_iau(:,:)    = 0.0 
    413463#endif 
    414       IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 
     464      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) & 
     465         &  .OR.( lk_bgcinc ) ) THEN 
    415466 
    416467         !-------------------------------------------------------------------- 
     
    545596         ENDIF 
    546597 
     598         IF ( lk_bgcinc ) THEN 
     599            CALL asm_bgc_init_incs( inum ) 
     600         ENDIF 
     601 
    547602         CALL iom_close( inum ) 
    548603  
     
    655710         CALL iom_close( inum ) 
    656711 
     712      ENDIF 
     713          
     714      IF ( lk_bgcinc ) THEN 
     715         CALL asm_bgc_init_bkg 
    657716      ENDIF 
    658717      ! 
     
    12761335 
    12771336   END SUBROUTINE seaice_asm_inc 
     1337 
     1338 
     1339   SUBROUTINE bgc_asm_inc( kt ) 
     1340      !!---------------------------------------------------------------------- 
     1341      !!                    ***  ROUTINE bgc_asm_inc  *** 
     1342      !!           
     1343      !! ** Purpose : Apply the biogeochemistry assimilation increments 
     1344      !! 
     1345      !! ** Method  : Call relevant routines in asmbgc 
     1346      !! 
     1347      !! ** Action  : Call relevant routines in asmbgc 
     1348      !! 
     1349      !!---------------------------------------------------------------------- 
     1350      !! 
     1351      INTEGER, INTENT(in   ) :: kt        ! Current time step 
     1352      ! 
     1353      INTEGER                :: icycper   ! Dimension of wgtiau 
     1354      !! 
     1355      !!---------------------------------------------------------------------- 
     1356       
     1357      icycper = SIZE( wgtiau ) 
     1358       
     1359      ! Ocean colour variables first 
     1360      IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 
     1361         & ln_slchlnaninc .OR. ln_slchlpicinc .OR. ln_slchldininc .OR. & 
     1362         & ln_schltotinc  .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 
     1363         & ln_slphynoninc ) THEN 
     1364         CALL phyto2d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 
     1365      ENDIF 
     1366       
     1367      ! Surface pCO2/fCO2 next 
     1368      IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 
     1369         CALL pco2_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 
     1370            &               ln_trainc, t_bkginc, s_bkginc ) 
     1371      ENDIF 
     1372       
     1373      ! Profile pH next 
     1374      IF ( ln_pphinc ) THEN 
     1375         CALL ph_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 
     1376            &             ln_trainc, t_bkginc, s_bkginc ) 
     1377      ENDIF 
     1378       
     1379      ! Then chlorophyll profiles 
     1380      IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 
     1381         CALL phyto3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 
     1382      ENDIF 
     1383       
     1384      ! Remaining bgc profile variables 
     1385      IF ( ln_pno3inc .OR. ln_psi4inc .OR. ln_pdicinc .OR. & 
     1386         & ln_palkinc .OR. ln_po2inc  .OR. ln_ppo4inc ) THEN 
     1387         CALL bgc3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 
     1388      ENDIF 
     1389 
     1390   END SUBROUTINE bgc_asm_inc 
    12781391    
    12791392   !!====================================================================== 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90

    r9180 r10850  
    2020      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the  
    2121                                                   !: reference trajectory 
    22       & c_asminc = 'assim_background_increments'  !: Filename for storing the  
     22      & c_asminc = 'assim_background_increments', & !: Filename for storing the  
    2323                                                   !: increments to the background 
    2424                                                   !: state 
     25      & c_asmbal = 'assim.balincs'                 !: Filename for storing the  
     26                                                   !: balancing increments calculated 
     27                                                   !: for biogeochemistry 
    2528 
    2629   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r8561 r10850  
    2121#endif 
    2222   USE diatmb 
     23#if defined key_fabm 
     24   USE trc, ONLY: trn 
     25   USE par_fabm 
     26   USE st2d_fabm, ONLY: fabm_st2dn 
     27   USE fabm, ONLY: fabm_get_interior_diagnostic_data, & 
     28      &            fabm_get_horizontal_diagnostic_data 
     29#endif 
    2330 
    2431   IMPLICIT NONE 
     
    3946#if defined key_zdfgls  
    4047   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h 
     48#endif 
     49#if defined key_fabm 
     50   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:,:) :: fabm_25h 
     51   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:,:) :: fabm_3d_25h 
     52   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_surface_25h 
     53   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_bottom_25h 
     54   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_2d_25h 
    4155#endif 
    4256   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
     
    6478      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6579      INTEGER ::   ierror              ! Local integer for memory allocation 
     80      INTEGER ::   jn                  ! Loop counter 
    6681      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    6782      ! 
     
    145160         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN 
    146161      ENDIF 
     162#if defined key_fabm 
     163      ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror ) 
     164      IF( ierror > 0 ) THEN 
     165         CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' )   ;   RETURN 
     166      ENDIF 
     167      ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror ) 
     168      IF( ierror > 0 ) THEN 
     169         CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' )   ;   RETURN 
     170      ENDIF 
     171      ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror ) 
     172      IF( ierror > 0 ) THEN 
     173         CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' )   ;   RETURN 
     174      ENDIF 
     175      ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror ) 
     176      IF( ierror > 0 ) THEN 
     177         CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' )   ;   RETURN 
     178      ENDIF 
     179      ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror ) 
     180      IF( ierror > 0 ) THEN 
     181         CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' )   ;   RETURN 
     182      ENDIF 
     183#endif  
    147184      ! ------------------------- ! 
    148185      ! 2 - Assign Initial Values ! 
     
    169206         rmxln_25h(:,:,:) = mxln(:,:,:) 
    170207#endif 
     208#if defined key_fabm 
     209      DO jn = 1, jp_fabm 
     210         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 
     211      END DO 
     212      DO jn = 1, jp_fabm_3d 
     213         fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn) 
     214      END DO 
     215      DO jn = 1, jp_fabm_surface 
     216         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 
     217      END DO 
     218      DO jn = 1, jp_fabm_bottom 
     219         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 
     220      END DO 
     221      DO jn = 1, jp_fabm_2d 
     222         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 
     223      END DO 
     224#endif 
    171225#if defined key_lim3 || defined key_lim2 
    172226         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
     
    207261 
    208262      !! * Local declarations 
    209       INTEGER ::   ji, jj, jk 
     263      INTEGER ::   ji, jj, jk, jn 
    210264 
    211265      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout 
     
    268322         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    269323#endif 
     324#if defined key_fabm 
     325      DO jn = 1, jp_fabm 
     326         fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn) 
     327      END DO 
     328      DO jn = 1, jp_fabm_3d 
     329         fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_interior_diagnostic_data(model, jn) 
     330      END DO 
     331      DO jn = 1, jp_fabm_surface 
     332         fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn) 
     333      END DO 
     334      DO jn = 1, jp_fabm_bottom 
     335         fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn) 
     336      END DO 
     337      DO jn = 1, jp_fabm_2d 
     338         fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn) 
     339      END DO 
     340#endif 
    270341         cnt_25h = cnt_25h + 1 
    271342 
     
    300371# if defined key_zdfgls 
    301372            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
     373#endif 
     374#if defined key_fabm 
     375            fabm_25h(:,:,:,:)       = fabm_25h(:,:,:,:)       / 25.0_wp 
     376            fabm_3d_25h(:,:,:,:)    = fabm_3d_25h(:,:,:,:)    / 25.0_wp 
     377            fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp 
     378            fabm_bottom_25h(:,:,:)  = fabm_bottom_25h(:,:,:)  / 25.0_wp 
     379            fabm_2d_25h(:,:,:)      = fabm_2d_25h(:,:,:)      / 25.0_wp 
    302380#endif 
    303381 
     
    319397            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    320398 
     399#if defined key_fabm 
     400            ! Write ERSEM variables 
     401            DO jn = 1, jp_fabm 
     402               zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     403               CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d  ) 
     404            END DO 
     405            DO jn = 1, jp_fabm_3d 
     406               zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     407               CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d  ) 
     408            END DO 
     409            DO jn = 1, jp_fabm_surface 
     410               zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     411               CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d  ) 
     412            END DO 
     413            DO jn = 1, jp_fabm_bottom 
     414               zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     415               CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d  ) 
     416            END DO 
     417            DO jn = 1, jp_fabm_2d 
     418               zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     419               CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d  ) 
     420            END DO 
     421#endif 
    321422 
    322423            ! Write velocities (instantaneous) 
     
    362463            rmxln_25h(:,:,:) = mxln(:,:,:) 
    363464#endif 
     465#if defined key_fabm 
     466      DO jn = 1, jp_fabm 
     467         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 
     468      END DO 
     469      DO jn = 1, jp_fabm_3d 
     470         fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn) 
     471      END DO 
     472      DO jn = 1, jp_fabm_surface 
     473         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 
     474      END DO 
     475      DO jn = 1, jp_fabm_bottom 
     476         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 
     477      END DO 
     478      DO jn = 1, jp_fabm_2d 
     479         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 
     480      END DO 
     481#endif 
    364482            cnt_25h = 1 
    365483            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90

    r8561 r10850  
    109109         CALL iom_put( "voce_op"   , vn                                    )    ! j-current 
    110110         !CALL iom_put( "woce_op"   , wn                                    )    ! k-current 
    111 #if defined key_spm 
    112          cltra = TRIM(ctrc3d(5))//"_op" 
    113          zw3d(:,:,:) = trc3d(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) ! Visibility 
    114          CALL iom_put( cltra, zw3d  ) 
    115 #endif 
    116111         CALL calc_max_cur(zwu,zwv,zwz,zmdi) 
    117112         CALL iom_put( "maxu" , zwu                                     ) ! max u current 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

    r8561 r10850  
    1111   USE iom             ! I/0 library 
    1212   USE wrk_nemo        ! working arrays 
     13#if defined key_fabm 
     14   USE trc, ONLY: trn 
     15   USE par_fabm 
     16   USE fabm, ONLY: fabm_get_interior_diagnostic_data 
     17#endif 
    1318 
    1419 
     
    133138      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace  
    134139      REAL(wp)                         ::   zmdi      ! set masked values 
     140      INTEGER                          ::   jn        ! loop counter 
    135141 
    136142      zmdi=1.e+20 !missing data indicator for maskin 
     
    162168         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity 
    163169!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity 
     170 
     171#if defined key_fabm 
     172         DO jn = 1, jp_fabm 
     173            CALL dia_calctmb( trn(:,:,:,jp_fabm_m1+jn), zwtmb ) 
     174            CALL iom_put( "top_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,1) ) 
     175            CALL iom_put( "mid_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,2) ) 
     176            CALL iom_put( "bot_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,3) ) 
     177         END DO 
     178         DO jn = 1, jp_fabm_3d 
     179            CALL dia_calctmb( fabm_get_interior_diagnostic_data(model, jn), zwtmb ) 
     180            CALL iom_put( "top_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,1) ) 
     181            CALL iom_put( "mid_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,2) ) 
     182            CALL iom_put( "bot_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,3) ) 
     183         END DO 
     184#endif 
    164185      ELSE 
    165186         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r8058 r10850  
    3838   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag 
    3939 
    40    !                       !!* Namelist  namzdf_tmx : tidal mixing * 
    41    REAL(wp) ::  rn_htmx     ! vertical decay scale for turbulence (meters) 
    42    REAL(wp) ::  rn_n2min    ! threshold of the Brunt-Vaisala frequency (s-1) 
    43    REAL(wp) ::  rn_tfe      ! tidal dissipation efficiency (St Laurent et al. 2002) 
    44    REAL(wp) ::  rn_me       ! mixing efficiency (Osborn 1980) 
    45    LOGICAL  ::  ln_tmx_itf  ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization 
    46    REAL(wp) ::  rn_tfe_itf  ! ITF tidal dissipation efficiency (St Laurent et al. 2002) 
    47  
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   en_tmx     ! energy available for tidal mixing (W/m2) 
    49    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)  ::   mask_itf   ! mask to use over Indonesian area 
    50    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz 
     40   !                              !!* Namelist  namzdf_tmx : tidal mixing * 
     41   REAL(wp)        ::  rn_htmx     ! vertical decay scale for turbulence (meters) 
     42   REAL(wp)        ::  rn_n2min    ! threshold of the Brunt-Vaisala frequency (s-1) 
     43   REAL(wp)        ::  rn_tfe      ! tidal dissipation efficiency (St Laurent et al. 2002) 
     44   REAL(wp)        ::  rn_me       ! mixing efficiency (Osborn 1980) 
     45   LOGICAL, PUBLIC ::  ln_tmx_itf  ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization 
     46   REAL(wp)        ::  rn_tfe_itf  ! ITF tidal dissipation efficiency (St Laurent et al. 2002) 
     47 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   en_tmx     ! energy available for tidal mixing (W/m2) 
     49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   mask_itf   ! mask to use over Indonesian area 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)       ::   az_tmx     ! coefficient used to evaluate the tidal induced Kz 
    5151 
    5252   !! * Substitutions 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r10394 r10850  
    6161   USE asminc          ! assimilation increments      
    6262   USE asmbkg          ! writing out state trajectory 
     63   USE asmbgc          ! biogeochemical assimilation increments 
    6364   USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    6465   USE diadct          ! sections transports           (dia_dct_init routine) 
     
    163164                IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics 
    164165                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH 
     166                IF( lk_bgcinc ) CALL bgc_asm_inc( nit000 - 1 )    ! BGC 
    165167             ENDIF 
    166168          ENDIF 
     
    194196 
    195197      IF( lk_diaobs   )   CALL dia_obs_wri 
     198      ! 
     199      IF( ( lk_asminc ).AND.( ln_balwri ) ) CALL asm_bgc_bal_wri( nitend )  ! Output balancing increments 
    196200      ! 
    197201      IF( ln_icebergs )   CALL icb_end( nitend ) 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/step.F90

    r10478 r10850  
    277277      ! Passive Tracer Model 
    278278      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     279      IF( lk_asminc .AND. ln_asmiau .AND. lk_bgcinc ) & 
     280         &               CALL bgc_asm_inc( kstp )     ! biogeochemistry assimilation 
    279281                         CALL trc_stp( kstp )         ! time-stepping 
    280282#endif 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90

    r10156 r10850  
    99   INTEGER, PUBLIC :: jp_fabm0, jp_fabm1, jp_fabm, & 
    1010                      jp_fabm_surface, jp_fabm_bottom, & 
    11                       jp_fabm_m1 
     11                      jp_fabm_m1, jp_fabm_2d, jp_fabm_3d 
     12 
     13   ! Variables needed for OBS/ASM 
     14   INTEGER, PUBLIC :: jp_fabm_chl1,  jp_fabm_chl2, & 
     15                      jp_fabm_chl3,  jp_fabm_chl4, & 
     16                      jp_fabm_p1c,   jp_fabm_p1n,  & 
     17                      jp_fabm_p1p,   jp_fabm_p1s,  & 
     18                      jp_fabm_p2c,   jp_fabm_p2n,  & 
     19                      jp_fabm_p2p,   jp_fabm_p3c,  & 
     20                      jp_fabm_p3n,   jp_fabm_p3p,  & 
     21                      jp_fabm_p4c,   jp_fabm_p4n,  & 
     22                      jp_fabm_p4p,   jp_fabm_z4c,  & 
     23                      jp_fabm_z5c,   jp_fabm_z5n,  & 
     24                      jp_fabm_z5p,   jp_fabm_z6c,  & 
     25                      jp_fabm_z6n,   jp_fabm_z6p,  & 
     26                      jp_fabm_n1p,   jp_fabm_n3n,  & 
     27                      jp_fabm_n4n,   jp_fabm_n5s,  & 
     28                      jp_fabm_o2o,   jp_fabm_o3c,  & 
     29                      jp_fabm_o3ta,  jp_fabm_o3ba, & 
     30                      jp_fabm_o3pc,  jp_fabm_o3ph, & 
     31                      jp_fabm_r4n,   jp_fabm_r4c,  & 
     32                      jp_fabm_r4p,   jp_fabm_r6n,  & 
     33                      jp_fabm_r6c,   jp_fabm_r6p,  & 
     34                      jp_fabm_r6s,   jp_fabm_r8n,  & 
     35                      jp_fabm_r8c,   jp_fabm_r8p,  & 
     36                      jp_fabm_r8s,                 & 
     37                      jp_fabm_pgrow, jp_fabm_ploss 
    1238 
    1339#if defined key_fabm 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90

    r10158 r10850  
    6565      jp_fabm_m1=jptra 
    6666      jptra = jptra + jp_fabm 
    67       jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables) 
    68       jpdia3d = jpdia3d + size(model%diagnostic_variables) 
     67      jp_fabm_2d = size(model%horizontal_diagnostic_variables) 
     68      jp_fabm_3d = size(model%diagnostic_variables) 
     69      jpdia2d = jpdia2d + jp_fabm_2d 
     70      jpdia3d = jpdia3d + jp_fabm_3d 
    6971      jpdiabio = jpdiabio + jp_fabm 
    7072 
    7173      !Initialize input data structures. 
    7274      call initialize_inputs 
     75 
     76      ! Get indexes for select state variables 
     77      jp_fabm_chl1 = fabm_state_index( 'P1_Chl' ) 
     78      jp_fabm_chl2 = fabm_state_index( 'P2_Chl' ) 
     79      jp_fabm_chl3 = fabm_state_index( 'P3_Chl' ) 
     80      jp_fabm_chl4 = fabm_state_index( 'P4_Chl' ) 
     81      jp_fabm_p1c  = fabm_state_index( 'P1_c' ) 
     82      jp_fabm_p1n  = fabm_state_index( 'P1_n' ) 
     83      jp_fabm_p1p  = fabm_state_index( 'P1_p' ) 
     84      jp_fabm_p1s  = fabm_state_index( 'P1_s' ) 
     85      jp_fabm_p2c  = fabm_state_index( 'P2_c' ) 
     86      jp_fabm_p2n  = fabm_state_index( 'P2_n' ) 
     87      jp_fabm_p2p  = fabm_state_index( 'P2_p' ) 
     88      jp_fabm_p3c  = fabm_state_index( 'P3_c' ) 
     89      jp_fabm_p3n  = fabm_state_index( 'P3_n' ) 
     90      jp_fabm_p3p  = fabm_state_index( 'P3_p' ) 
     91      jp_fabm_p4c  = fabm_state_index( 'P4_c' ) 
     92      jp_fabm_p4n  = fabm_state_index( 'P4_n' ) 
     93      jp_fabm_p4p  = fabm_state_index( 'P4_p' ) 
     94      jp_fabm_z4c  = fabm_state_index( 'Z4_c' ) 
     95      jp_fabm_z5c  = fabm_state_index( 'Z5_c' ) 
     96      jp_fabm_z5n  = fabm_state_index( 'Z5_n' ) 
     97      jp_fabm_z5p  = fabm_state_index( 'Z5_p' ) 
     98      jp_fabm_z6c  = fabm_state_index( 'Z6_c' ) 
     99      jp_fabm_z6n  = fabm_state_index( 'Z6_n' ) 
     100      jp_fabm_z6p  = fabm_state_index( 'Z6_p' ) 
     101      jp_fabm_n1p  = fabm_state_index( 'N1_p' ) 
     102      jp_fabm_n3n  = fabm_state_index( 'N3_n' ) 
     103      jp_fabm_n4n  = fabm_state_index( 'N4_n' ) 
     104      jp_fabm_n5s  = fabm_state_index( 'N5_s' ) 
     105      jp_fabm_o2o  = fabm_state_index( 'O2_o' ) 
     106      jp_fabm_o3c  = fabm_state_index( 'O3_c' ) 
     107      jp_fabm_o3ba = fabm_state_index( 'O3_bioalk' ) 
     108      jp_fabm_r4n  = fabm_state_index( 'R4_n' ) 
     109      jp_fabm_r4c  = fabm_state_index( 'R4_c' ) 
     110      jp_fabm_r4p  = fabm_state_index( 'R4_p' ) 
     111      jp_fabm_r6n  = fabm_state_index( 'R6_n' ) 
     112      jp_fabm_r6c  = fabm_state_index( 'R6_c' ) 
     113      jp_fabm_r6p  = fabm_state_index( 'R6_p' ) 
     114      jp_fabm_r6s  = fabm_state_index( 'R6_s' ) 
     115      jp_fabm_r8n  = fabm_state_index( 'R8_n' ) 
     116      jp_fabm_r8c  = fabm_state_index( 'R8_c' ) 
     117      jp_fabm_r8p  = fabm_state_index( 'R8_p' ) 
     118      jp_fabm_r8s  = fabm_state_index( 'R8_s' ) 
     119 
     120      ! Get indexes for select diagnostic variables 
     121      jp_fabm_o3ta  = fabm_diag_index( 'O3_TA' ) 
     122      jp_fabm_o3ph  = fabm_diag_index( 'O3_pH' ) 
     123      jp_fabm_o3pc  = fabm_diag_index( 'O3_pCO2' ) 
     124      jp_fabm_pgrow = fabm_diag_index( 'p_grow_sum_result' ) 
     125      jp_fabm_ploss = fabm_diag_index( 'p_loss_sum_result' ) 
     126       
     127      MLD_MAX(:,:)   = 0.0 
     128      PGROW_AVG(:,:) = 0.0 
     129      PLOSS_AVG(:,:) = 0.0 
     130      PHYT_AVG(:,:)  = 0.0 
    73131 
    74132      IF (lwp) THEN 
     
    84142            CALL write_trends_xml(xml_unit,model%state_variables(jn)) 
    85143#endif 
     144            CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 
     145            CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 
    86146         END DO 
    87147         WRITE (xml_unit,1000) ' </field_group>' 
     
    90150         DO jn=1,jp_fabm_surface 
    91151            CALL write_variable_xml(xml_unit,model%surface_state_variables(jn)) 
     152            CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn)) 
    92153         END DO 
    93154         DO jn=1,jp_fabm_bottom 
    94155            CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn)) 
     156            CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn)) 
    95157         END DO 
    96158         WRITE (xml_unit,1000) ' </field_group>' 
     
    99161         DO jn=1,size(model%diagnostic_variables) 
    100162            CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3) 
     163            CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3) 
     164            CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn)) 
    101165         END DO 
    102166         DO jn=1,size(model%horizontal_diagnostic_variables) 
    103167            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
     168            CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
    104169         END DO 
    105170         WRITE (xml_unit,1000) ' </field_group>' 
     
    168233 
    169234   END SUBROUTINE write_variable_xml 
     235 
     236   SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref) 
     237      INTEGER,INTENT(IN) :: xml_unit 
     238      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
     239      CLASS (type_external_variable),INTENT(IN) :: variable 
     240 
     241      CHARACTER(LEN=20) :: missing_value,string_dimensions 
     242      INTEGER :: number_dimensions 
     243 
     244      ! Check variable dimension for grid_ref specificaiton. 
     245      ! Default is to not specify the grid_ref in the field definition. 
     246      IF (present(flag_grid_ref)) THEN 
     247          number_dimensions=flag_grid_ref 
     248      ELSE 
     249          number_dimensions=-1 !default, don't specify grid_ref 
     250      ENDIF 
     251 
     252      WRITE (missing_value,'(E9.3)') 1.e+20 
     253      WRITE (string_dimensions,'(I1)') number_dimensions 
     254      SELECT CASE (number_dimensions) 
     255      CASE (3) 
     256         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 
     257      CASE (2) 
     258         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 
     259      CASE (0) 
     260         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="1point"/>' 
     261      CASE (-1) 
     262         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 
     263      CASE default 
     264         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise output of variable '//TRIM(variable%name)//'25h'//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional variables not supported!!!' 
     265      END SELECT 
     266 
     267   END SUBROUTINE write_25hourm_xml 
     268 
     269   SUBROUTINE write_tmb_xml(xml_unit,variable) 
     270      INTEGER,INTENT(IN) :: xml_unit 
     271      CLASS (type_external_variable),INTENT(IN) :: variable 
     272 
     273      CHARACTER(LEN=20) :: missing_value 
     274 
     275      WRITE (missing_value,'(E9.3)') 1.e+20 
     276      WRITE (xml_unit,'(A)') '  <field id="top_'//TRIM(variable%name)//'" long_name="Top-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 
     277      WRITE (xml_unit,'(A)') '  <field id="mid_'//TRIM(variable%name)//'" long_name="Middle-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 
     278      WRITE (xml_unit,'(A)') '  <field id="bot_'//TRIM(variable%name)//'" long_name="Bottom-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 
     279 
     280   END SUBROUTINE write_tmb_xml 
    170281 
    171282   SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref) 
     
    328439   END SUBROUTINE trc_ini_fabm 
    329440 
     441   INTEGER FUNCTION fabm_state_index( state_name ) 
     442      !!---------------------------------------------------------------------- 
     443      !!                     ***  fabm_state_index  ***   
     444      !! 
     445      !! ** Purpose :   return index of a given FABM state variable 
     446      !! 
     447      !! ** Method  : - loop through state variables until found 
     448      !!---------------------------------------------------------------------- 
     449       
     450      IMPLICIT NONE 
     451       
     452      CHARACTER(LEN=256), INTENT(IN) :: state_name 
     453       
     454      INTEGER                        :: jn 
     455 
     456      !!---------------------------------------------------------------------- 
     457       
     458      fabm_state_index = -1 
     459      DO jn=1,jp_fabm 
     460         IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 
     461            fabm_state_index = jn 
     462            EXIT 
     463         ENDIF 
     464      END DO 
     465      IF (fabm_state_index == -1) THEN 
     466         CALL ctl_warn( 'Could not find '//TRIM(state_name)//' state variable' ) 
     467      ELSE 
     468         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index 
     469      ENDIF 
     470    
     471   END FUNCTION fabm_state_index 
     472 
     473   INTEGER FUNCTION fabm_diag_index( diag_name ) 
     474      !!---------------------------------------------------------------------- 
     475      !!                     ***  fabm_state_index  ***   
     476      !! 
     477      !! ** Purpose :   return index of a given FABM diagnostic variable 
     478      !! 
     479      !! ** Method  : - loop through diagnostic variables until found 
     480      !!---------------------------------------------------------------------- 
     481       
     482      IMPLICIT NONE 
     483       
     484      CHARACTER(LEN=256), INTENT(IN) :: diag_name 
     485       
     486      INTEGER                        :: jn 
     487 
     488      !!---------------------------------------------------------------------- 
     489       
     490      fabm_diag_index = -1 
     491      DO jn = 1, SIZE(model%diagnostic_variables) 
     492         IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
     493            fabm_diag_index = jn 
     494            EXIT 
     495         ENDIF 
     496      END DO 
     497      IF (fabm_diag_index == -1) THEN 
     498         CALL ctl_warn( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 
     499      ELSE 
     500         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 
     501      ENDIF 
     502    
     503   END FUNCTION fabm_diag_index 
     504 
    330505#else 
    331506   !!---------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90

    r10156 r10850  
    3333   USE inputs_fabm 
    3434   USE vertical_movement_fabm 
     35   USE zdfmxl 
     36   USE asmbgc, ONLY: mld_choice_bgc 
     37   USE lbclnk 
    3538 
    3639   !USE fldread         !  time interpolation 
     
    113116 
    114117      CALL st2d_fabm_nxt( kt ) 
     118       
     119      CALL asmdiags_fabm( kt ) 
    115120 
    116121      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrfabm ) 
     
    130135 
    131136   END SUBROUTINE trc_sms_fabm 
     137    
     138   SUBROUTINE asmdiags_fabm( kt ) 
     139      INTEGER, INTENT(IN) :: kt 
     140      INTEGER :: ji,jj,jk,jkmax 
     141      REAL(wp), DIMENSION(jpi,jpj,jpk) :: pgrow_3d, ploss_3d, zmld 
     142       
     143      IF (kt == nittrc000) THEN 
     144         MLD_MAX(:,:) = 0.0 
     145      ENDIF 
     146      PGROW_AVG(:,:) = 0.0 
     147      PLOSS_AVG(:,:) = 0.0 
     148      PHYT_AVG(:,:)  = 0.0 
     149         
     150      pgrow_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_pgrow) 
     151      ploss_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_ploss) 
     152       
     153      SELECT CASE( mld_choice_bgc ) 
     154      CASE ( 1 )                   ! Turbocline/mixing depth [W points] 
     155         zmld(:,:) = hmld(:,:) 
     156      CASE ( 2 )                   ! Density criterion (0.01 kg/m^3 change from 10m) [W points] 
     157         zmld(:,:) = hmlp(:,:) 
     158      CASE ( 3 )                   ! Kara MLD [Interpolated] 
     159#if defined key_karaml 
     160         IF ( ln_kara ) THEN 
     161            zmld(:,:) = hmld_kara(:,:) 
     162         ELSE 
     163            CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 
     164               &           ' but ln_kara=.false.' ) 
     165         ENDIF 
     166#else 
     167         CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 
     168            &           ' but is not defined' ) 
     169#endif 
     170      CASE ( 4 )                   ! Temperature criterion (0.2 K change from surface) [T points] 
     171         zmld(:,:) = hmld_tref(:,:) 
     172      CASE ( 5 )                   ! Density criterion (0.01 kg/m^3 change from 10m) [T points] 
     173         zmld(:,:) = hmlpt(:,:) 
     174      END SELECT 
     175    
     176      DO jj = 2, jpjm1 
     177         DO ji = 2, jpim1 
     178            ! 
     179            jkmax = jpk-1 
     180            DO jk = jpk-1, 1, -1 
     181               IF ( ( zmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
     182                  & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
     183                  zmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
     184                  jkmax = jk 
     185               ENDIF 
     186            END DO 
     187            ! 
     188            DO jk = 1, jkmax 
     189               PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) + & 
     190                  &              trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) + & 
     191                  &              trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) + & 
     192                  &              trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) + & 
     193                  &              trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) 
     194               IF ( pgrow_3d(ji,jj,jk) .GT. 0.0 ) THEN 
     195                  PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) + & 
     196                     &               pgrow_3d(ji,jj,jk) 
     197               ENDIF 
     198               IF ( ploss_3d(ji,jj,jk) .GT. 0.0 ) THEN 
     199                  PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) + & 
     200                     &               ploss_3d(ji,jj,jk) 
     201               ENDIF 
     202            END DO 
     203            
     204            PHYT_AVG(ji,jj)  = PHYT_AVG(ji,jj)  / REAL(jkmax) 
     205            PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) / REAL(jkmax) 
     206            PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) / REAL(jkmax) 
     207    
     208            IF ( zmld(ji,jj) .GT. MLD_MAX(ji,jj) ) THEN 
     209               MLD_MAX(ji,jj) = zmld(ji,jj) 
     210            ENDIF 
     211            ! 
     212         END DO 
     213      END DO 
     214       
     215      PHYT_AVG(:,:)  = PHYT_AVG(:,:)  * tmask(:,:,1) 
     216      PGROW_AVG(:,:) = PGROW_AVG(:,:) * tmask(:,:,1) 
     217      PLOSS_AVG(:,:) = PLOSS_AVG(:,:) * tmask(:,:,1) 
     218      MLD_MAX(:,:)   = MLD_MAX(:,:)   * tmask(:,:,1) 
     219       
     220   END SUBROUTINE asmdiags_fabm 
    132221 
    133222   SUBROUTINE compute_fabm() 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r10162 r10850  
    225225#endif 
    226226 
     227#if defined key_fabm 
     228   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  PGROW_AVG  !: Phytoplankton growth for use in ASM code 
     229   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  PLOSS_AVG  !: Phytoplankton loss   for use in ASM code 
     230   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  PHYT_AVG   !: Phytoplankton        for use in ASM code 
     231   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  MLD_MAX    !: Maximum MLD          for use in ASM code 
     232#endif 
     233 
    227234   !!---------------------------------------------------------------------- 
    228235   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
     
    253260! FABM <<<+++ 
    254261         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     262         &      PGROW_AVG(jpi,jpj)    , PLOSS_AVG(jpi,jpj)    , PHYT_AVG(jpi,jpj)     ,       & 
     263         &      MLD_MAX(jpi,jpj)      ,                                                       & 
    255264#endif 
    256265#if defined key_bdy 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r10162 r10850  
    4646#  include "domzgr_substitute.h90" 
    4747   !!---------------------------------------------------------------------- 
    48    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     48   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4949   !! $Id$ 
    5050   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
Note: See TracChangeset for help on using the changeset viewer.