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

Ignore:
Timestamp:
2018-11-14T18:42:09+01:00 (5 years ago)
Author:
dford
Message:

svn merge -r 10183:10261 ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/AMM15_v3_6_STABLE_package_bgc_updates

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r10158 r10308  
    1818   USE trcsms_fabm 
    1919   USE fabm_config,ONLY: fabm_create_model_from_yaml_file 
    20    USE fabm,ONLY: type_external_variable, fabm_initialize_library 
     20   USE fabm,ONLY: type_external_variable, fabm_initialize_library, & 
     21                  fabm_get_bulk_diagnostic_data 
    2122   USE inputs_fabm,ONLY: initialize_inputs,link_inputs, & 
    2223     type_input_variable,type_input_data,type_river_data, & 
    … …  
    6566      jp_fabm_m1=jptra 
    6667      jptra = jptra + jp_fabm 
    67       jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables) 
    68       jpdia3d = jpdia3d + size(model%diagnostic_variables) 
     68      jp_fabm_2d = size(model%horizontal_diagnostic_variables) 
     69      jp_fabm_3d = size(model%diagnostic_variables) 
     70      jpdia2d = jpdia2d + jp_fabm_2d 
     71      jpdia3d = jpdia3d + jp_fabm_3d 
    6972      jpdiabio = jpdiabio + jp_fabm 
    7073 
    7174      !Initialize input data structures. 
    7275      call initialize_inputs 
     76 
     77      ! Get indexes for select state variables 
     78      jp_fabm_chl1 = fabm_state_index( 'P1_Chl' ) 
     79      jp_fabm_chl2 = fabm_state_index( 'P2_Chl' ) 
     80      jp_fabm_chl3 = fabm_state_index( 'P3_Chl' ) 
     81      jp_fabm_chl4 = fabm_state_index( 'P4_Chl' ) 
     82      jp_fabm_p1c  = fabm_state_index( 'P1_c' ) 
     83      jp_fabm_p1n  = fabm_state_index( 'P1_n' ) 
     84      jp_fabm_p1p  = fabm_state_index( 'P1_p' ) 
     85      jp_fabm_p1s  = fabm_state_index( 'P1_s' ) 
     86      jp_fabm_p2c  = fabm_state_index( 'P2_c' ) 
     87      jp_fabm_p2n  = fabm_state_index( 'P2_n' ) 
     88      jp_fabm_p2p  = fabm_state_index( 'P2_p' ) 
     89      jp_fabm_p3c  = fabm_state_index( 'P3_c' ) 
     90      jp_fabm_p3n  = fabm_state_index( 'P3_n' ) 
     91      jp_fabm_p3p  = fabm_state_index( 'P3_p' ) 
     92      jp_fabm_p4c  = fabm_state_index( 'P4_c' ) 
     93      jp_fabm_p4n  = fabm_state_index( 'P4_n' ) 
     94      jp_fabm_p4p  = fabm_state_index( 'P4_p' ) 
     95      jp_fabm_z4c  = fabm_state_index( 'Z4_c' ) 
     96      jp_fabm_z5c  = fabm_state_index( 'Z5_c' ) 
     97      jp_fabm_z5n  = fabm_state_index( 'Z5_n' ) 
     98      jp_fabm_z5p  = fabm_state_index( 'Z5_p' ) 
     99      jp_fabm_z6c  = fabm_state_index( 'Z6_c' ) 
     100      jp_fabm_z6n  = fabm_state_index( 'Z6_n' ) 
     101      jp_fabm_z6p  = fabm_state_index( 'Z6_p' ) 
     102      jp_fabm_n1p  = fabm_state_index( 'N1_p' ) 
     103      jp_fabm_n3n  = fabm_state_index( 'N3_n' ) 
     104      jp_fabm_n4n  = fabm_state_index( 'N4_n' ) 
     105      jp_fabm_n5s  = fabm_state_index( 'N5_s' ) 
     106      jp_fabm_o2o  = fabm_state_index( 'O2_o' ) 
     107      jp_fabm_o3c  = fabm_state_index( 'O3_c' ) 
     108      jp_fabm_o3a  = fabm_state_index( 'O3_bioalk' ) 
     109 
     110      ! Get indexes for select diagnostic variables 
     111      jp_fabm_o3ph = fabm_diag_index( 'O3_pH' ) 
     112      jp_fabm_o3pc = fabm_diag_index( 'O3_pCO2' ) 
     113      jp_fabm_xeps = fabm_diag_index( 'light_xEPS') 
    73114 
    74115      IF (lwp) THEN 
    … …  
    84125            CALL write_trends_xml(xml_unit,model%state_variables(jn)) 
    85126#endif 
     127            CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 
     128            CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 
    86129         END DO 
    87130         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    90133         DO jn=1,jp_fabm_surface 
    91134            CALL write_variable_xml(xml_unit,model%surface_state_variables(jn)) 
     135            CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn)) 
    92136         END DO 
    93137         DO jn=1,jp_fabm_bottom 
    94138            CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn)) 
     139            CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn)) 
    95140         END DO 
    96141         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    99144         DO jn=1,size(model%diagnostic_variables) 
    100145            CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3) 
     146            CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3) 
     147            CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn)) 
    101148         END DO 
    102149         DO jn=1,size(model%horizontal_diagnostic_variables) 
    103150            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
    104          END DO 
     151            CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
     152         END DO 
     153         WRITE (xml_unit,'(A)') '  <field id="visib" long_name="visibility" unit="m" default_value="1.e+20" grid_ref="grid_T_3D" />' 
     154         WRITE (xml_unit,'(A)') '  <field id="visib25h" long_name="visibility 25-hour mean" unit="m" default_value="1.e+20" grid_ref="grid_T_3D" />' 
     155         WRITE (xml_unit,'(A)') '  <field id="top_visib" long_name="Top-level visibility" unit="m" default_value="1.e+20" grid_ref="grid_T_2D" />' 
     156         WRITE (xml_unit,'(A)') '  <field id="mid_visib" long_name="Middle-level visibility" unit="m" default_value="1.e+20" grid_ref="grid_T_2D" />' 
     157         WRITE (xml_unit,'(A)') '  <field id="bot_visib" long_name="Bottom-level visibility" unit="m" default_value="1.e+20" grid_ref="grid_T_2D" />' 
    105158         WRITE (xml_unit,1000) ' </field_group>' 
    106159 
    … …  
    168221 
    169222   END SUBROUTINE write_variable_xml 
     223 
     224   SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref) 
     225      INTEGER,INTENT(IN) :: xml_unit 
     226      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
     227      CLASS (type_external_variable),INTENT(IN) :: variable 
     228 
     229      CHARACTER(LEN=20) :: missing_value,string_dimensions 
     230      INTEGER :: number_dimensions 
     231 
     232      ! Check variable dimension for grid_ref specificaiton. 
     233      ! Default is to not specify the grid_ref in the field definition. 
     234      IF (present(flag_grid_ref)) THEN 
     235          number_dimensions=flag_grid_ref 
     236      ELSE 
     237          number_dimensions=-1 !default, don't specify grid_ref 
     238      ENDIF 
     239 
     240      WRITE (missing_value,'(E9.3)') 1.e+20 
     241      WRITE (string_dimensions,'(I1)') number_dimensions 
     242      SELECT CASE (number_dimensions) 
     243      CASE (3) 
     244         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" />' 
     245      CASE (2) 
     246         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"/>' 
     247      CASE (0) 
     248         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"/>' 
     249      CASE (-1) 
     250         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))//'" />' 
     251      CASE default 
     252         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!!!' 
     253      END SELECT 
     254 
     255   END SUBROUTINE write_25hourm_xml 
     256 
     257   SUBROUTINE write_tmb_xml(xml_unit,variable) 
     258      INTEGER,INTENT(IN) :: xml_unit 
     259      CLASS (type_external_variable),INTENT(IN) :: variable 
     260 
     261      CHARACTER(LEN=20) :: missing_value 
     262 
     263      WRITE (missing_value,'(E9.3)') 1.e+20 
     264      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"/>' 
     265      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"/>' 
     266      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"/>' 
     267 
     268   END SUBROUTINE write_tmb_xml 
    170269 
    171270   SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref) 
    … …  
    304403#endif 
    305404 
     405      ! Initialise visibility 
     406      visib(:,:,:) = 1.7 / fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) 
     407 
    306408      ! Log mapping of FABM states: 
    307409      IF (lwp) THEN 
    … …  
    328430   END SUBROUTINE trc_ini_fabm 
    329431 
     432   INTEGER FUNCTION fabm_state_index( state_name ) 
     433      !!---------------------------------------------------------------------- 
     434      !!                     ***  fabm_state_index  ***   
     435      !! 
     436      !! ** Purpose :   return index of a given FABM state variable 
     437      !! 
     438      !! ** Method  : - loop through state variables until found 
     439      !!---------------------------------------------------------------------- 
     440       
     441      IMPLICIT NONE 
     442       
     443      CHARACTER(LEN=256), INTENT(IN) :: state_name 
     444       
     445      INTEGER                        :: jn 
     446 
     447      !!---------------------------------------------------------------------- 
     448       
     449      fabm_state_index = -1 
     450      DO jn=1,jp_fabm 
     451         IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 
     452            fabm_state_index = jn 
     453            EXIT 
     454         ENDIF 
     455      END DO 
     456      IF (fabm_state_index == -1) THEN 
     457         CALL ctl_stop( 'Could not find '//TRIM(state_name)//' state variable' ) 
     458      ELSE 
     459         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index 
     460      ENDIF 
     461    
     462   END FUNCTION fabm_state_index 
     463 
     464   INTEGER FUNCTION fabm_diag_index( diag_name ) 
     465      !!---------------------------------------------------------------------- 
     466      !!                     ***  fabm_state_index  ***   
     467      !! 
     468      !! ** Purpose :   return index of a given FABM diagnostic variable 
     469      !! 
     470      !! ** Method  : - loop through diagnostic variables until found 
     471      !!---------------------------------------------------------------------- 
     472       
     473      IMPLICIT NONE 
     474       
     475      CHARACTER(LEN=256), INTENT(IN) :: diag_name 
     476       
     477      INTEGER                        :: jn 
     478 
     479      !!---------------------------------------------------------------------- 
     480       
     481      fabm_diag_index = -1 
     482      DO jn = 1, SIZE(model%diagnostic_variables) 
     483         IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
     484            fabm_diag_index = jn 
     485            EXIT 
     486         ENDIF 
     487      END DO 
     488      IF (fabm_diag_index == -1) THEN 
     489         CALL ctl_stop( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 
     490      ELSE 
     491         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 
     492      ENDIF 
     493    
     494   END FUNCTION fabm_diag_index 
     495 
    330496#else 
    331497   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.