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

Changeset 10390


Ignore:
Timestamp:
2018-12-14T13:53:52+01:00 (5 years ago)
Author:
dford
Message:

Add 25-hour mean and top-middle-bottom diagnostics for all variables available through FABM, and set up indices for specific variables for easier access by OBS/ASM. See internal Met Office NEMO ticket 760.

Location:
branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO
Files:
6 edited

Legend:

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

    r8561 r10390  
    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/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90

    r8561 r10390  
    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/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

    r8561 r10390  
    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/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90

    r10156 r10390  
    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_o3a,  jp_fabm_o3ph, & 
     30                      jp_fabm_o3pc 
    1231 
    1332#if defined key_fabm 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90

    r10158 r10390  
    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)') 1.e+20 
     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)') 1.e+20 
     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   !!---------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r10162 r10390  
    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.