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 13576 for branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90 – NEMO

Ignore:
Timestamp:
2020-10-09T12:35:11+02:00 (4 years ago)
Author:
dford
Message:

Update NEMO-FABM coupler for FABM v1, and introduce two-way NEMO-ERSEM coupling options. See ​https://code.metoffice.gov.uk/trac/utils/ticket/366.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90

    r12352 r13576  
    44   !! TOP :   initialisation of the FABM tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
     6   !! History :   1.0  !  2015-04  (PML) Original code 
     7   !! History :   1.1  !  2020-06  (PML) Update to FABM 1.0, improved performance 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_fabm 
    … …  
    1718   USE par_fabm 
    1819   USE trcsms_fabm 
    19    USE fabm_config,ONLY: fabm_create_model_from_yaml_file 
    20    USE fabm,ONLY: type_external_variable, fabm_initialize_library 
    21    USE inputs_fabm,ONLY: initialize_inputs,link_inputs, & 
     20   USE fabm, only: fabm_create_model, type_fabm_variable 
     21   USE fabm_driver 
     22   USE inputs_fabm,ONLY: initialize_inputs, link_inputs, & 
    2223     type_input_variable,type_input_data,type_river_data, & 
    2324     first_input_data,first_river_data 
    … …  
    3334 
    3435#if defined key_git_version 
    35 !#include "gitversion.h90" 
     36#  include "gitversion.h90" 
    3637   CHARACTER(len=*),parameter :: git_commit_id = _NEMO_COMMIT_ID_ 
    3738   CHARACTER(len=*),parameter :: git_branch_name = _NEMO_BRANCH_ 
    … …  
    3940 
    4041   PUBLIC   trc_ini_fabm   ! called by trcini.F90 module 
    41    PUBLIC   nemo_fabm_init 
     42   PUBLIC   nemo_fabm_configure 
     43 
     44   TYPE,extends(type_base_driver) :: type_nemo_fabm_driver 
     45   contains 
     46      procedure :: fatal_error => nemo_fabm_driver_fatal_error 
     47      procedure :: log_message => nemo_fabm_driver_log_message 
     48   end type 
    4249 
    4350   !!---------------------------------------------------------------------- 
    … …  
    4855CONTAINS 
    4956 
    50    SUBROUTINE nemo_fabm_init() 
     57   SUBROUTINE nemo_fabm_configure() 
    5158      INTEGER :: jn 
    5259      INTEGER, PARAMETER :: xml_unit = 1979 
    … …  
    5562      CLASS (type_input_variable),POINTER :: input_pointer 
    5663 
     64      ALLOCATE(type_nemo_fabm_driver::driver) 
     65 
    5766      ! Allow FABM to parse fabm.yaml. This ensures numbers of variables are known. 
    58       call fabm_create_model_from_yaml_file(model) 
    59  
    60       jp_fabm = size(model%state_variables) 
     67      model => fabm_create_model() 
     68 
     69      jp_fabm = size(model%interior_state_variables) 
    6170      jp_fabm_bottom = size(model%bottom_state_variables) 
    6271      jp_fabm_surface = size(model%surface_state_variables) 
    … …  
    6675      jptra = jptra + jp_fabm 
    6776      jp_fabm_2d = size(model%horizontal_diagnostic_variables) 
    68       jp_fabm_3d = size(model%diagnostic_variables) 
     77      jp_fabm_3d = size(model%interior_diagnostic_variables) 
    6978      jpdia2d = jpdia2d + jp_fabm_2d 
    7079      jpdia3d = jpdia3d + jp_fabm_3d 
    7180      jpdiabio = jpdiabio + jp_fabm 
    7281 
    73       !Initialize input data structures. 
     82      ! Read inputs (river and additional 2D forcing) from fabm_input.nml 
     83      ! This must be done before writing field_def_fabm.xml, as that file 
     84      ! also describes the additional input variables. 
    7485      call initialize_inputs 
    7586 
    … …  
    123134      jp_fabm_o3pc  = fabm_diag_index( 'O3_pCO2' ) 
    124135      jp_fabm_xeps  = fabm_diag_index( 'light_xEPS' ) 
     136      jp_fabm_swr   = fabm_diag_index( 'light_swr_abs' ) 
     137      jp_fabm_kd490 = fabm_diag_index( 'light_Kd_band3' ) 
    125138      jp_fabm_pgrow = fabm_diag_index( 'p_grow_sum_result' ) 
    126139      jp_fabm_ploss = fabm_diag_index( 'p_loss_sum_result' ) 
    … …  
    128141      IF (lwp) THEN 
    129142         ! write field_def_fabm.xml on lead process 
    130          OPEN(UNIT=xml_unit,FILE='field_def_fabm.xml',ACTION='WRITE',STATUS='REPLACE') 
     143         OPEN(UNIT=xml_unit, FILE='field_def_fabm.xml', ACTION='WRITE', STATUS='REPLACE') 
    131144 
    132145         WRITE (xml_unit,1000) '<field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" >' 
    … …  
    134147         WRITE (xml_unit,1000) ' <field_group id="ptrc_T" grid_ref="grid_T_3D">' 
    135148         DO jn=1,jp_fabm 
    136             CALL write_variable_xml(xml_unit,model%state_variables(jn)) 
     149            CALL write_variable_xml(xml_unit,model%interior_state_variables(jn)) 
    137150#if defined key_trdtrc 
    138             CALL write_trends_xml(xml_unit,model%state_variables(jn)) 
    139 #endif 
    140             CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 
    141             CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 
     151            CALL write_trends_xml(xml_unit,model%interior_state_variables(jn)) 
     152#endif 
     153            CALL write_25hourm_xml(xml_unit,model%interior_state_variables(jn)) 
     154            CALL write_tmb_xml(xml_unit,model%interior_state_variables(jn)) 
    142155         END DO 
    143156         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    155168 
    156169         WRITE (xml_unit,1000) ' <field_group id="diad_T" grid_ref="grid_T_2D">' 
    157          DO jn=1,size(model%diagnostic_variables) 
    158             CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3) 
    159             CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3) 
    160             CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn)) 
     170         DO jn=1,size(model%interior_diagnostic_variables) 
     171            CALL write_variable_xml(xml_unit,model%interior_diagnostic_variables(jn),3) 
     172            CALL write_25hourm_xml(xml_unit,model%interior_diagnostic_variables(jn),3) 
     173            CALL write_tmb_xml(xml_unit,model%interior_diagnostic_variables(jn)) 
    161174         END DO 
    162175         DO jn=1,size(model%horizontal_diagnostic_variables) 
    163176            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
    164177            CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
     178         END DO 
     179         DO jn=1,size(model%interior_state_variables) 
     180            WRITE (xml_unit,'(A)') '  <field id="'//TRIM(model%interior_state_variables(jn)%name)// & 
     181               &                   '_VINT" long_name="depth-integrated '//TRIM(model%interior_state_variables(jn)%long_name)// & 
     182               &                   '" unit="'//TRIM(model%interior_state_variables(jn)%units)//'*m" default_value="0.0" />' 
     183         END DO 
     184         DO jn=1,size(model%interior_diagnostic_variables) 
     185            WRITE (xml_unit,'(A)') '  <field id="'//TRIM(model%interior_diagnostic_variables(jn)%name)// & 
     186               &                   '_VINT" long_name="depth-integrated '//TRIM(model%interior_diagnostic_variables(jn)%long_name)// & 
     187               &                   '" unit="'//TRIM(model%interior_diagnostic_variables(jn)%units)//'*m" default_value="0.0" />' 
    165188         END DO 
    166189         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    1952181000 FORMAT (A) 
    196219 
    197    END SUBROUTINE nemo_fabm_init 
     220   END SUBROUTINE nemo_fabm_configure 
    198221 
    199222   SUBROUTINE write_variable_xml(xml_unit,variable,flag_grid_ref) 
    200223      INTEGER,INTENT(IN) :: xml_unit 
    201224      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
    202       CLASS (type_external_variable),INTENT(IN) :: variable 
     225      CLASS (type_fabm_variable),INTENT(IN) :: variable 
    203226 
    204227      CHARACTER(LEN=20) :: missing_value,string_dimensions 
    … …  
    233256      INTEGER,INTENT(IN) :: xml_unit 
    234257      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
    235       CLASS (type_external_variable),INTENT(IN) :: variable 
     258      CLASS (type_fabm_variable),INTENT(IN) :: variable 
    236259 
    237260      CHARACTER(LEN=20) :: missing_value,string_dimensions 
    … …  
    265288   SUBROUTINE write_tmb_xml(xml_unit,variable) 
    266289      INTEGER,INTENT(IN) :: xml_unit 
    267       CLASS (type_external_variable),INTENT(IN) :: variable 
     290      CLASS (type_fabm_variable),INTENT(IN) :: variable 
    268291 
    269292      CHARACTER(LEN=20) :: missing_value 
    … …  
    279302      INTEGER,INTENT(IN) :: xml_unit 
    280303      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
    281       CLASS (type_external_variable),INTENT(IN) :: variable 
     304      CLASS (type_fabm_variable),INTENT(IN) :: variable 
    282305 
    283306      INTEGER :: number_dimensions,i 
    … …  
    383406      !! ** Purpose :   initialization for FABM model 
    384407      !! 
    385       !! ** Method  : - Read the namcfc namelist and check the parameter values 
     408      !! ** Method  : - Allocate FABM arrays, configure domain, send data 
    386409      !!---------------------------------------------------------------------- 
    387410#if defined key_git_version 
    388       TYPE (type_version),POINTER :: version 
     411      TYPE (type_version), POINTER :: version 
    389412#endif 
    390413      INTEGER :: jn 
    391  
    392       !                       ! Allocate FABM arrays 
    393       IF( trc_sms_fabm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_fabm: unable to allocate FABM arrays' ) 
    394414 
    395415      IF(lwp) WRITE(numout,*) 
    … …  
    399419      IF(lwp) WRITE(numout,*) ' NEMO version:   ',git_commit_id,' (',git_branch_name,' branch)' 
    400420      IF(lwp) WRITE(numout,*) ' FABM version:   ',fabm_commit_id,' (',fabm_branch_name,' branch)' 
    401 #endif 
    402  
    403       call fabm_initialize_library() 
    404 #if defined key_git_version 
    405421      version => first_module_version 
    406  
    407422      do while (associated(version)) 
    408423         IF(lwp) WRITE(numout,*)  ' '//trim(version%module_name)//' version:   ',trim(version%version_string) 
    … …  
    411426#endif 
    412427 
     428      ! Allocate FABM arrays 
     429      IF(trc_sms_fabm_alloc() /= 0) CALL ctl_stop( 'STOP', 'trc_ini_fabm: unable to allocate FABM arrays' ) 
     430 
    413431      ! Log mapping of FABM states: 
    414432      IF (lwp) THEN 
    415          IF (jp_fabm.gt.0) WRITE(numout,*) " FABM tracers:" 
     433         IF (jp_fabm > 0) WRITE(numout,*) " FABM tracers:" 
    416434         DO jn=1,jp_fabm 
    417             WRITE(numout,*) "   State",jn,":",trim(model%state_variables(jn)%name), & 
    418                " (",trim(model%state_variables(jn)%long_name), & 
    419                ") [",trim(model%state_variables(jn)%units),"]" 
    420          ENDDO 
    421          IF (jp_fabm_surface.gt.0) WRITE(numout,*) "FABM seasurface states:" 
     435            WRITE(numout,*) "   State",jn,":",trim(model%interior_state_variables(jn)%name), & 
     436               " (",trim(model%interior_state_variables(jn)%long_name), & 
     437               ") [",trim(model%interior_state_variables(jn)%units),"]" 
     438         END DO 
     439         IF (jp_fabm_surface > 0) WRITE(numout,*) "FABM seasurface states:" 
    422440         DO jn=1,jp_fabm_surface 
    423441            WRITE(numout,*) "   State",jn,":",trim(model%surface_state_variables(jn)%name), & 
    424442               " (",trim(model%surface_state_variables(jn)%long_name), & 
    425443               ") [",trim(model%surface_state_variables(jn)%units),"]" 
    426          ENDDO 
    427          IF (jp_fabm_bottom.gt.0) WRITE(numout,*) "FABM seafloor states:" 
     444         END DO 
     445         IF (jp_fabm_bottom > 0) WRITE(numout,*) "FABM seafloor states:" 
    428446         DO jn=1,jp_fabm_bottom 
    429447            WRITE(numout,*) "   State",jn,":",trim(model%bottom_state_variables(jn)%name), & 
    430448               " (",trim(model%bottom_state_variables(jn)%long_name), & 
    431449               ") [",trim(model%bottom_state_variables(jn)%units),"]" 
    432          ENDDO 
    433       ENDIF 
     450         END DO 
     451      END IF 
    434452       
    435453      ! Initialise variables required for Hemmings et al. (2008) 
    … …  
    442460   END SUBROUTINE trc_ini_fabm 
    443461 
     462   SUBROUTINE nemo_fabm_driver_fatal_error(self, location, message) 
     463      CLASS (type_nemo_fabm_driver), INTENT(INOUT) :: self 
     464      CHARACTER(len=*),              INTENT(IN)    :: location, message 
     465 
     466      CALL ctl_stop('STOP', TRIM(location)//': '//TRIM(message)) 
     467      STOP 
     468   END SUBROUTINE 
     469 
     470   SUBROUTINE nemo_fabm_driver_log_message(self, message) 
     471      CLASS (type_nemo_fabm_driver), INTENT(INOUT) :: self 
     472      CHARACTER(len=*),              INTENT(IN)    :: message 
     473 
     474      IF(lwp) WRITE (numout,*) TRIM(message) 
     475   END SUBROUTINE 
     476 
    444477   INTEGER FUNCTION fabm_state_index( state_name ) 
    445478      !!---------------------------------------------------------------------- 
    … …  
    453486      IMPLICIT NONE 
    454487       
    455       CHARACTER(LEN=256), INTENT(IN) :: state_name 
    456        
    457       INTEGER                        :: jn 
     488      CHARACTER(LEN=*), INTENT(IN) :: state_name 
     489       
     490      INTEGER                      :: jn 
    458491 
    459492      !!---------------------------------------------------------------------- 
    … …  
    461494      fabm_state_index = -1 
    462495      DO jn=1,jp_fabm 
    463          IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 
     496         IF (TRIM(model%interior_state_variables(jn)%name) == TRIM(state_name)) THEN 
    464497            fabm_state_index = jn 
    465498            EXIT 
    … …  
    485518      IMPLICIT NONE 
    486519       
    487       CHARACTER(LEN=256), INTENT(IN) :: diag_name 
    488        
    489       INTEGER                        :: jn 
     520      CHARACTER(LEN=*), INTENT(IN) :: diag_name 
     521       
     522      INTEGER                      :: jn 
    490523 
    491524      !!---------------------------------------------------------------------- 
    492525       
    493526      fabm_diag_index = -1 
    494       DO jn = 1, SIZE(model%diagnostic_variables) 
    495          IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
     527      DO jn = 1, SIZE(model%interior_diagnostic_variables) 
     528         IF (TRIM(model%interior_diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
    496529            fabm_diag_index = jn 
    497530            EXIT 
Note: See TracChangeset for help on using the changeset viewer.