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

Ignore:
Timestamp:
2018-10-19T13:36:08+02:00 (6 years ago)
Author:
dford
Message:

Add 25h mean and TMB diagnostics for FABM-ERSEM variables.

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r10158 r10205  
    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_o3a  = fabm_state_index( 'O3_bioalk' ) 
     108 
     109      ! Get indexes for select diagnostic variables 
     110      jp_fabm_o3ph   = fabm_diag_index( 'O3_pH' ) 
     111      jp_fabm_o3pc   = fabm_diag_index( 'O3_pCO2') 
    73112 
    74113      IF (lwp) THEN 
    … …  
    84123            CALL write_trends_xml(xml_unit,model%state_variables(jn)) 
    85124#endif 
     125            CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 
     126            CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 
    86127         END DO 
    87128         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    90131         DO jn=1,jp_fabm_surface 
    91132            CALL write_variable_xml(xml_unit,model%surface_state_variables(jn)) 
     133            CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn)) 
    92134         END DO 
    93135         DO jn=1,jp_fabm_bottom 
    94136            CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn)) 
     137            CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn)) 
    95138         END DO 
    96139         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    99142         DO jn=1,size(model%diagnostic_variables) 
    100143            CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3) 
     144            CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3) 
     145            CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn)) 
    101146         END DO 
    102147         DO jn=1,size(model%horizontal_diagnostic_variables) 
    103148            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
     149            CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 
    104150         END DO 
    105151         WRITE (xml_unit,1000) ' </field_group>' 
    … …  
    168214 
    169215   END SUBROUTINE write_variable_xml 
     216 
     217   SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref) 
     218      INTEGER,INTENT(IN) :: xml_unit 
     219      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 
     220      CLASS (type_external_variable),INTENT(IN) :: variable 
     221 
     222      CHARACTER(LEN=20) :: missing_value,string_dimensions 
     223      INTEGER :: number_dimensions 
     224 
     225      ! Check variable dimension for grid_ref specificaiton. 
     226      ! Default is to not specify the grid_ref in the field definition. 
     227      IF (present(flag_grid_ref)) THEN 
     228          number_dimensions=flag_grid_ref 
     229      ELSE 
     230          number_dimensions=-1 !default, don't specify grid_ref 
     231      ENDIF 
     232 
     233      WRITE (missing_value,'(E9.3)') variable%missing_value 
     234      WRITE (string_dimensions,'(I1)') number_dimensions 
     235      SELECT CASE (number_dimensions) 
     236      CASE (3) 
     237         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" />' 
     238      CASE (2) 
     239         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"/>' 
     240      CASE (0) 
     241         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"/>' 
     242      CASE (-1) 
     243         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))//'" />' 
     244      CASE default 
     245         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!!!' 
     246      END SELECT 
     247 
     248   END SUBROUTINE write_25hourm_xml 
     249 
     250   SUBROUTINE write_tmb_xml(xml_unit,variable) 
     251      INTEGER,INTENT(IN) :: xml_unit 
     252      CLASS (type_external_variable),INTENT(IN) :: variable 
     253 
     254      CHARACTER(LEN=20) :: missing_value 
     255 
     256      WRITE (missing_value,'(E9.3)') variable%missing_value 
     257      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"/>' 
     258      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"/>' 
     259      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"/>' 
     260 
     261   END SUBROUTINE write_tmb_xml 
    170262 
    171263   SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref) 
    … …  
    328420   END SUBROUTINE trc_ini_fabm 
    329421 
     422   INTEGER FUNCTION fabm_state_index( state_name ) 
     423      !!---------------------------------------------------------------------- 
     424      !!                     ***  fabm_state_index  ***   
     425      !! 
     426      !! ** Purpose :   return index of a given FABM state variable 
     427      !! 
     428      !! ** Method  : - loop through state variables until found 
     429      !!---------------------------------------------------------------------- 
     430       
     431      IMPLICIT NONE 
     432       
     433      CHARACTER(LEN=256), INTENT(IN) :: state_name 
     434       
     435      INTEGER                        :: jn 
     436 
     437      !!---------------------------------------------------------------------- 
     438       
     439      fabm_state_index = -1 
     440      DO jn=1,jp_fabm 
     441         IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 
     442            fabm_state_index = jn 
     443            EXIT 
     444         ENDIF 
     445      END DO 
     446      IF (fabm_state_index == -1) THEN 
     447         CALL ctl_stop( 'Could not find '//TRIM(state_name)//' state variable' ) 
     448      ELSE 
     449         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index 
     450      ENDIF 
     451    
     452   END FUNCTION fabm_state_index 
     453 
     454   INTEGER FUNCTION fabm_diag_index( diag_name ) 
     455      !!---------------------------------------------------------------------- 
     456      !!                     ***  fabm_state_index  ***   
     457      !! 
     458      !! ** Purpose :   return index of a given FABM diagnostic variable 
     459      !! 
     460      !! ** Method  : - loop through diagnostic variables until found 
     461      !!---------------------------------------------------------------------- 
     462       
     463      IMPLICIT NONE 
     464       
     465      CHARACTER(LEN=256), INTENT(IN) :: diag_name 
     466       
     467      INTEGER                        :: jn 
     468 
     469      !!---------------------------------------------------------------------- 
     470       
     471      fabm_diag_index = -1 
     472      DO jn = 1, SIZE(model%diagnostic_variables) 
     473         IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 
     474            fabm_diag_index = jn 
     475            EXIT 
     476         ENDIF 
     477      END DO 
     478      IF (fabm_diag_index == -1) THEN 
     479         CALL ctl_stop( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 
     480      ELSE 
     481         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 
     482      ENDIF 
     483    
     484   END FUNCTION fabm_diag_index 
     485 
    330486#else 
    331487   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.