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

Changeset 8049


Ignore:
Timestamp:
2017-05-19T15:32:50+02:00 (7 years ago)
Author:
dford
Message:

Add FABM-related code changes.

Location:
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO
Files:
15 edited
1 copied

Legend:

Unmodified
Added
Removed
  • branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r7590 r8049  
    2121#endif 
    2222   USE diatmb 
     23#if defined key_fabm 
     24   USE trc, ONLY: trn 
     25   USE par_fabm 
     26   USE fabm, ONLY: fabm_get_bulk_diagnostic_data 
     27#endif 
    2328 
    2429   IMPLICIT NONE 
     
    3944#if defined key_zdfgls  
    4045   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h 
     46#endif 
     47#if defined key_fabm 
     48   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:,:) :: fabm3d_25h 
    4149#endif 
    4250   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
     
    145153         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN 
    146154      ENDIF 
     155#if defined key_fabm 
     156      ALLOCATE( fabm3d_25h(jpi,jpj,jpk,jp_fabmdia_3dout), STAT=ierror ) 
     157      IF( ierror > 0 ) THEN 
     158         CALL ctl_stop( 'dia_tide: unable to allocate fabm3d_25h' )   ;   RETURN 
     159      ENDIF 
     160#endif  
    147161      ! ------------------------- ! 
    148162      ! 2 - Assign Initial Values ! 
     
    169183         rmxln_25h(:,:,:) = mxln(:,:,:) 
    170184#endif 
     185#if defined key_fabm 
     186      fabm3d_25h(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n1p) 
     187      fabm3d_25h(:,:,:,2) = trn(:,:,:,jp_fabm_m1+jp_fabm_n3n) 
     188      fabm3d_25h(:,:,:,3) = trn(:,:,:,jp_fabm_m1+jp_fabm_n4n) 
     189      fabm3d_25h(:,:,:,4) = trn(:,:,:,jp_fabm_m1+jp_fabm_n5s) 
     190      fabm3d_25h(:,:,:,5) = trn(:,:,:,jp_fabm_m1+jp_fabm_o2o) 
     191      fabm3d_25h(:,:,:,6)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph)  
     192      fabm3d_25h(:,:,:,7)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 
     193      fabm3d_25h(:,:,:,8)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot)  
     194      fabm3d_25h(:,:,:,9)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp)  
     195      fabm3d_25h(:,:,:,10)= fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps)  
     196      fabm3d_25h(:,:,:,11)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot)  
     197#endif 
    171198#if defined key_lim3 || defined key_lim2 
    172199         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
     
    268295         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    269296#endif 
     297#if defined key_fabm 
     298         fabm3d_25h(:,:,:,1) = fabm3d_25h(:,:,:,1) + trn(:,:,:,jp_fabm_m1+jp_fabm_n1p)   ! phosphate 
     299         fabm3d_25h(:,:,:,2) = fabm3d_25h(:,:,:,2) + trn(:,:,:,jp_fabm_m1+jp_fabm_n3n)   ! nitrate 
     300         fabm3d_25h(:,:,:,3) = fabm3d_25h(:,:,:,3) + trn(:,:,:,jp_fabm_m1+jp_fabm_n4n)   ! ammonium 
     301         fabm3d_25h(:,:,:,4) = fabm3d_25h(:,:,:,4) + trn(:,:,:,jp_fabm_m1+jp_fabm_n5s)   ! silicate 
     302         fabm3d_25h(:,:,:,5) = fabm3d_25h(:,:,:,5) + trn(:,:,:,jp_fabm_m1+jp_fabm_o2o)   ! oxygen 
     303         fabm3d_25h(:,:,:,6)= fabm3d_25h(:,:,:,6) + fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph) ! pH 
     304         fabm3d_25h(:,:,:,7)= fabm3d_25h(:,:,:,7) + fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) ! pCO2 
     305         fabm3d_25h(:,:,:,8)= fabm3d_25h(:,:,:,8) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) ! total Chl 
     306         fabm3d_25h(:,:,:,9)= fabm3d_25h(:,:,:,9) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp) ! netPP 
     307         fabm3d_25h(:,:,:,10)= fabm3d_25h(:,:,:,10) + fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) ! light attenuation 
     308         fabm3d_25h(:,:,:,11)= fabm3d_25h(:,:,:,11) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot) ! total phytoplankton 
     309#endif 
    270310         cnt_25h = cnt_25h + 1 
    271311 
     
    300340# if defined key_zdfgls 
    301341            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
     342#endif 
     343#if defined key_fabm 
     344            fabm3d_25h(:,:,:,:) = fabm3d_25h(:,:,:,:) / 25.0_wp 
    302345#endif 
    303346 
     
    319362            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    320363 
     364#if defined key_fabm 
     365            ! Write ERSEM variables 
     366            zw3d(:,:,:) = fabm3d_25h(:,:,:,1)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     367            CALL iom_put( "N1p25h", zw3d  )   ! phosphate 
     368            zw3d(:,:,:) = fabm3d_25h(:,:,:,2)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     369            CALL iom_put( "N3n25h", zw3d  )   ! nitrate 
     370            zw3d(:,:,:) = fabm3d_25h(:,:,:,3)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     371            CALL iom_put( "N4n25h", zw3d  )   ! ammonium 
     372            zw3d(:,:,:) = fabm3d_25h(:,:,:,4)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     373            CALL iom_put( "N5s25h", zw3d  )   ! silicate 
     374            zw3d(:,:,:) = fabm3d_25h(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     375            CALL iom_put( "O2o25h", zw3d  )   ! oxygen 
     376            zw3d(:,:,:) = fabm3d_25h(:,:,:,6)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     377            CALL iom_put( "pH25h", zw3d  )   ! pH 
     378            zw3d(:,:,:) = fabm3d_25h(:,:,:,7)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     379            CALL iom_put( "pCO2_25h", zw3d  )   ! pCO2 
     380            zw3d(:,:,:) = fabm3d_25h(:,:,:,8)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     381            CALL iom_put( "CHL25h", zw3d  )   ! total Chl 
     382            zw3d(:,:,:) = fabm3d_25h(:,:,:,9)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     383            CALL iom_put( "netPP25h", zw3d  ) ! netPP 
     384            zw3d(:,:,:) = (1.7/fabm3d_25h(:,:,:,10))*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     385            CALL iom_put( "visib25h", zw3d  ) ! light attenuation convert to visibility 
     386            zw3d(:,:,:) = fabm3d_25h(:,:,:,11)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     387            CALL iom_put( "PhytoC25h", zw3d  )   ! total phytoplankton 
     388#endif 
    321389 
    322390            ! Write velocities (instantaneous) 
     
    362430            rmxln_25h(:,:,:) = mxln(:,:,:) 
    363431#endif 
     432#if defined key_fabm 
     433            fabm3d_25h(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n1p) 
     434            fabm3d_25h(:,:,:,2) = trn(:,:,:,jp_fabm_m1+jp_fabm_n3n) 
     435            fabm3d_25h(:,:,:,3) = trn(:,:,:,jp_fabm_m1+jp_fabm_n4n) 
     436            fabm3d_25h(:,:,:,4) = trn(:,:,:,jp_fabm_m1+jp_fabm_n5s) 
     437            fabm3d_25h(:,:,:,5) = trn(:,:,:,jp_fabm_m1+jp_fabm_o2o) 
     438            fabm3d_25h(:,:,:,6)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph) 
     439            fabm3d_25h(:,:,:,7)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc)  
     440            fabm3d_25h(:,:,:,8)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 
     441            fabm3d_25h(:,:,:,9)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp) 
     442            fabm3d_25h(:,:,:,10)= fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) 
     443            fabm3d_25h(:,:,:,11)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot) 
     444#endif 
    364445            cnt_25h = 1 
    365446            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/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90

    r7835 r8049  
    1010                      jp_fabm_surface, jp_fabm_bottom, & 
    1111                      jp_fabm_m1 
     12 
     13   INTEGER, PUBLIC :: jp_fabm_chl1, jp_fabm_chl2, & 
     14                      jp_fabm_chl3, jp_fabm_chl4, & 
     15                      jp_fabm_p1c,  jp_fabm_p1n,  & 
     16                      jp_fabm_p1p,  jp_fabm_p1s,  & 
     17                      jp_fabm_p2c,  jp_fabm_p2n,  & 
     18                      jp_fabm_p2p,  jp_fabm_p3c,  & 
     19                      jp_fabm_p3n,  jp_fabm_p3p,  & 
     20                      jp_fabm_p4c,  jp_fabm_p4n,  & 
     21                      jp_fabm_p4p,  jp_fabm_z4c,  & 
     22                      jp_fabm_z5c,  jp_fabm_z5n,  & 
     23                      jp_fabm_z5p,  jp_fabm_z6c,  & 
     24                      jp_fabm_z6n,  jp_fabm_z6p,  & 
     25                      jp_fabm_n1p,  jp_fabm_n3n,  & 
     26                      jp_fabm_n4n,  jp_fabm_n5s,  & 
     27                      jp_fabm_o2o,  jp_fabm_netp1, & 
     28                      jp_fabm_netp2,jp_fabm_netp3, & 
     29                      jp_fabm_netp4,jp_fabm_o3ph,  & 
     30                      jp_fabm_o3pc, jp_fabm_xeps 
     31 
     32   INTEGER, PUBLIC :: jp_fabmdia_3dout = 12 
     33 
     34   INTEGER, PUBLIC :: jp_fabmdia_chltot, jp_fabmdia_netpp, jp_fabmdia_phytot 
    1235 
    1336#if defined key_fabm 
  • branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90

    r7835 r8049  
    6868      jpdia3d = jpdia3d + size(model%diagnostic_variables) 
    6969      jpdiabio = jpdiabio + jp_fabm 
    70        
     70 
    7171      !Initialize input data structures. 
    7272      call initialize_inputs 
     73 
     74      IF(lwp) WRITE(numout,*) 'DAF: jp_fabm, jp_fabm0, jp_fabm1, jp_fabm_m1, jptra = ', jp_fabm, jp_fabm0, jp_fabm1, jp_fabm_m1, jptra 
     75       
     76      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
     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_netp1= fabm_diag_index( 'P1_netP' ) 
     107      !jp_fabm_netp2= fabm_diag_index( 'P2_netP' ) 
     108      !jp_fabm_netp3= fabm_diag_index( 'P3_netP' ) 
     109      !jp_fabm_netp4= fabm_diag_index( 'P4_netP' ) 
     110      !jp_fabm_o3ph = fabm_diag_index( 'ph_reported_on_total_scale' ) 
     111      !jp_fabm_o3pc = fabm_diag_index( 'mole_concentration_of_carbonate_expressed_as_carbon') 
     112      jp_fabm_o3ph = fabm_diag_index( 'O3_pH' ) 
     113      jp_fabm_o3pc = fabm_diag_index( 'O3_pCO2') 
     114      jp_fabmdia_chltot = fabm_diag_index( 'total_chlorophyll_calculator_result' ) 
     115      jp_fabmdia_netpp = fabm_diag_index( 'net_primary_production_result' ) 
     116      jp_fabm_xeps = fabm_diag_index( 'light_xEPS' ) 
     117      jp_fabmdia_phytot = fabm_diag_index( 'total_phytoplankton_result' ) 
     118 
     119      IF(lwp) WRITE(numout,*) 'DAF: jp_fabm_n5s = ', jp_fabm_n5s 
     120 
     121      !jp_fabmdia_chltot = fabm_diag_index( 'total_chlorophyll' ) 
     122      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
    73123       
    74124      IF (lwp) THEN 
     
    190240      WRITE (missing_value,'(E9.3)') -2.E20 
    191241      WRITE (string_dimensions,'(I1)') number_dimensions 
    192       SELECT CASE (number_dimensions) 
    193       CASE (3) 
    194         DO i=1,size(trd_tags) 
    195          WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'// & 
    196             &                   TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 
    197         END DO 
    198       CASE (-1) 
    199         DO i=1,size(trd_tags) 
    200          WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'// & 
    201             &                   TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 
    202         END DO 
    203       CASE default 
    204          IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!' 
    205       END SELECT 
     242      !SELECT CASE (number_dimensions) 
     243      !CASE (3) 
     244      !  DO i=1,size(trd_tags) 
     245      !   WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 
     246      !  END DO 
     247      !CASE (-1) 
     248      !  DO i=1,size(trd_tags) 
     249      !   WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 
     250      !  END DO 
     251      !CASE default 
     252      !   IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!' 
     253      !END SELECT 
    206254 
    207255   END SUBROUTINE write_trends_xml 
     
    294342   END SUBROUTINE trc_ini_fabm 
    295343 
     344   INTEGER FUNCTION fabm_state_index( state_name ) 
     345      !!---------------------------------------------------------------------- 
     346      !!                     ***  fabm_state_index  ***   
     347      !! 
     348      !! ** Purpose :   return index of a given FABM state variable 
     349      !! 
     350      !! ** Method  : - loop through state variables until found 
     351      !!---------------------------------------------------------------------- 
     352       
     353      IMPLICIT NONE 
     354       
     355      CHARACTER(LEN=256), INTENT(IN) :: state_name 
     356       
     357      INTEGER                        :: jn 
     358 
     359      !!---------------------------------------------------------------------- 
     360       
     361      fabm_state_index = -1 
     362      !WRITE(numout,*) 'PETE - STATE VARIABLES' 
     363      DO jn=1,jp_fabm          
     364         !WRITE(numout,*) TRIM(model%state_variables(jn)%name) 
     365         IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 
     366            fabm_state_index = jn 
     367            EXIT 
     368         ENDIF 
     369      END DO 
     370      IF (fabm_state_index == -1) THEN 
     371         CALL ctl_stop( 'Could not find '//TRIM(state_name)//' state variable' ) 
     372      ELSE 
     373         IF (lwp) WRITE(numout,*) 'DAF: Index for '//TRIM(state_name)//' is: ', fabm_state_index 
     374      ENDIF 
     375    
     376   END FUNCTION fabm_state_index 
     377 
     378   INTEGER FUNCTION fabm_diag_index( diag_name ) 
     379      !!---------------------------------------------------------------------- 
     380      !!                     ***  fabm_state_index  ***   
     381      !! 
     382      !! ** Purpose :   return index of a given FABM diagnostic variable 
     383      !! 
     384      !! ** Method  : - loop through diagnostic variables until found 
     385      !!---------------------------------------------------------------------- 
     386       
     387      IMPLICIT NONE 
     388       
     389      CHARACTER(LEN=256), INTENT(IN) :: diag_name 
     390       
     391      INTEGER                        :: jn 
     392 
     393      !!---------------------------------------------------------------------- 
     394       
     395      fabm_diag_index = -1 
     396      !WRITE(numout,*) 'PETE - DIAG VARIABLES' 
     397      DO jn = 1, SIZE(model%diagnostic_variables) 
     398         !WRITE(numout,*) TRIM(model%diagnostic_variables(jn)%name) 
     399         !WRITE(numout,*) TRIM(model%diagnostic_variables(jn)%standard_variable%name) 
     400         IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
     401            fabm_diag_index = jn 
     402            EXIT 
     403         ENDIF 
     404      END DO 
     405      IF (fabm_diag_index == -1) THEN 
     406         CALL ctl_stop( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 
     407      ELSE 
     408         IF (lwp) WRITE(numout,*) 'DAF: Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 
     409      ENDIF 
     410    
     411   END FUNCTION fabm_diag_index 
     412 
    296413#else 
    297414   !!---------------------------------------------------------------------- 
  • branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

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

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

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

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

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

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

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

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

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

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

    r6332 r8049  
    110110      ! 
    111111      ztrai = 0._wp                                                   !  content of all tracers 
    112       DO jn = 1, jptra 
    113          ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    114       END DO 
    115       IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
     112      !DO jn = 1, jptra 
     113      !   ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     114      !END DO 
     115      !IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
    1161169300  FORMAT(i10,e18.10) 
    117117      ! 
  • branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

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