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

Changeset 10308


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

Location:
branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO
Files:
8 edited

Legend:

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

    r8561 r10308  
    2121#endif 
    2222   USE diatmb 
     23#if defined key_fabm 
     24   USE trc, ONLY: trn, visib 
     25   USE par_fabm 
     26   USE st2d_fabm, ONLY: fabm_st2dn 
     27   USE fabm, ONLY: fabm_get_bulk_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 
     55   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_visib_25h 
    4156#endif 
    4257   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
     
    6479      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6580      INTEGER ::   ierror              ! Local integer for memory allocation 
     81      INTEGER ::   jn                  ! Loop counter 
    6682      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    6783      ! 
     
    145161         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN 
    146162      ENDIF 
     163#if defined key_fabm 
     164      ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror ) 
     165      IF( ierror > 0 ) THEN 
     166         CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' )   ;   RETURN 
     167      ENDIF 
     168      ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror ) 
     169      IF( ierror > 0 ) THEN 
     170         CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' )   ;   RETURN 
     171      ENDIF 
     172      ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror ) 
     173      IF( ierror > 0 ) THEN 
     174         CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' )   ;   RETURN 
     175      ENDIF 
     176      ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror ) 
     177      IF( ierror > 0 ) THEN 
     178         CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' )   ;   RETURN 
     179      ENDIF 
     180      ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror ) 
     181      IF( ierror > 0 ) THEN 
     182         CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' )   ;   RETURN 
     183      ENDIF 
     184      ALLOCATE( fabm_visib_25h(jpi,jpj,jpk), STAT=ierror ) 
     185      IF( ierror > 0 ) THEN 
     186         CALL ctl_stop( 'dia_25h: unable to allocate fabm_visib_25h' )   ;   RETURN 
     187      ENDIF 
     188#endif  
    147189      ! ------------------------- ! 
    148190      ! 2 - Assign Initial Values ! 
     
    169211         rmxln_25h(:,:,:) = mxln(:,:,:) 
    170212#endif 
     213#if defined key_fabm 
     214      DO jn = 1, jp_fabm 
     215         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 
     216      END DO 
     217      DO jn = 1, jp_fabm_3d 
     218         fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 
     219      END DO 
     220      DO jn = 1, jp_fabm_surface 
     221         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 
     222      END DO 
     223      DO jn = 1, jp_fabm_bottom 
     224         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 
     225      END DO 
     226      DO jn = 1, jp_fabm_2d 
     227         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 
     228      END DO 
     229      fabm_visib_25h(:,:,:) = visib(:,:,:) 
     230#endif 
    171231#if defined key_lim3 || defined key_lim2 
    172232         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
     
    207267 
    208268      !! * Local declarations 
    209       INTEGER ::   ji, jj, jk 
     269      INTEGER ::   ji, jj, jk, jn 
    210270 
    211271      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout 
     
    268328         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    269329#endif 
     330#if defined key_fabm 
     331      DO jn = 1, jp_fabm 
     332         fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn) 
     333      END DO 
     334      DO jn = 1, jp_fabm_3d 
     335         fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_bulk_diagnostic_data(model, jn) 
     336      END DO 
     337      DO jn = 1, jp_fabm_surface 
     338         fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn) 
     339      END DO 
     340      DO jn = 1, jp_fabm_bottom 
     341         fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn) 
     342      END DO 
     343      DO jn = 1, jp_fabm_2d 
     344         fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn) 
     345      END DO 
     346      fabm_visib_25h(:,:,:) = fabm_visib_25h(:,:,:) + visib(:,:,:) 
     347#endif 
    270348         cnt_25h = cnt_25h + 1 
    271349 
     
    300378# if defined key_zdfgls 
    301379            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
     380#endif 
     381#if defined key_fabm 
     382            fabm_25h(:,:,:,:)       = fabm_25h(:,:,:,:)       / 25.0_wp 
     383            fabm_3d_25h(:,:,:,:)    = fabm_3d_25h(:,:,:,:)    / 25.0_wp 
     384            fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp 
     385            fabm_bottom_25h(:,:,:)  = fabm_bottom_25h(:,:,:)  / 25.0_wp 
     386            fabm_2d_25h(:,:,:)      = fabm_2d_25h(:,:,:)      / 25.0_wp 
     387            fabm_visib_25h(:,:,:)   = fabm_visib_25h(:,:,:)   / 25.0_wp 
    302388#endif 
    303389 
     
    319405            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    320406 
     407#if defined key_fabm 
     408            ! Write ERSEM variables 
     409            DO jn = 1, jp_fabm 
     410               zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     411               CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d  ) 
     412            END DO 
     413            DO jn = 1, jp_fabm_3d 
     414               zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     415               CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d  ) 
     416            END DO 
     417            DO jn = 1, jp_fabm_surface 
     418               zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     419               CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d  ) 
     420            END DO 
     421            DO jn = 1, jp_fabm_bottom 
     422               zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     423               CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d  ) 
     424            END DO 
     425            DO jn = 1, jp_fabm_2d 
     426               zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     427               CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d  ) 
     428            END DO 
     429            zw3d(:,:,:) = fabm_visib_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     430            CALL iom_put( "visib25h", zw3d  ) 
     431#endif 
    321432 
    322433            ! Write velocities (instantaneous) 
     
    362473            rmxln_25h(:,:,:) = mxln(:,:,:) 
    363474#endif 
     475#if defined key_fabm 
     476      DO jn = 1, jp_fabm 
     477         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 
     478      END DO 
     479      DO jn = 1, jp_fabm_3d 
     480         fabm_3d_25h(:,:,:,jn) = fabm_get_bulk_diagnostic_data(model, jn) 
     481      END DO 
     482      DO jn = 1, jp_fabm_surface 
     483         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 
     484      END DO 
     485      DO jn = 1, jp_fabm_bottom 
     486         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 
     487      END DO 
     488      DO jn = 1, jp_fabm_2d 
     489         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 
     490      END DO 
     491      fabm_visib_25h(:,:,:) = visib(:,:,:) 
     492#endif 
    364493            cnt_25h = 1 
    365494            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_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90

    r8561 r10308  
    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 
     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 
    116116         CALL calc_max_cur(zwu,zwv,zwz,zmdi) 
    117117         CALL iom_put( "maxu" , zwu                                     ) ! max u current 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

    r8561 r10308  
    1111   USE iom             ! I/0 library 
    1212   USE wrk_nemo        ! working arrays 
     13#if defined key_fabm 
     14   USE trc, ONLY: trn, visib 
     15   USE par_fabm 
     16   USE fabm, ONLY: fabm_get_bulk_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_bulk_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         CALL dia_calctmb( visib(:,:,:), zwtmb ) 
     185         CALL iom_put( "top_visib" , zwtmb(:,:,1) ) 
     186         CALL iom_put( "mid_visib" , zwtmb(:,:,2) ) 
     187         CALL iom_put( "bot_visib" , zwtmb(:,:,3) ) 
     188#endif 
    164189      ELSE 
    165190         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_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90

    r10156 r10308  
    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, jp_fabm_xeps 
    1231 
    1332#if defined key_fabm 
  • 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   !!---------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90

    r10156 r10308  
    3737 
    3838   USE fabm 
     39   USE par_fabm 
    3940 
    4041   IMPLICIT NONE 
     
    118119      CALL trc_bc_read  ( kt )       ! tracers: surface and lateral Boundary Conditions 
    119120      CALL trc_rnf_fabm ( kt ) ! River forcings 
     121       
     122      visib(:,:,:) = 1.7 / fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) 
    120123 
    121124      IF( l_trdtrc ) THEN      ! Save the trends in the mixed layer 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90

    r10270 r10308  
    8181      INTEGER, INTENT( in )               :: kt 
    8282      INTEGER              :: jn 
     83       
     84      REAL(wp), DIMENSION(jpi,jpj,jpk)    :: zw3d 
    8385 
    8486#if defined key_tracer_budget 
     
    105107             CALL iom_put( model%diagnostic_variables(jn)%name, fabm_get_bulk_diagnostic_data(model,jn)) 
    106108      END DO 
     109      zw3d(:,:,:) = visib(:,:,:)*tmask(:,:,:) + 1.e+20*(1.0-tmask(:,:,:)) 
     110      CALL iom_put( 'visib', zw3d ) 
    107111 
    108112      ! write 2D diagnostics in the file 
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r10162 r10308  
    149149   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic 
    150150   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs 
     151#if defined key_fabm 
     152   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  visib          !: visibility 
     153#endif 
    151154 
    152155   !! Biological trends 
     
    253256! FABM <<<+++ 
    254257         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
     258         &      visib(jpi,jpj,jpk)    ,                                                       & 
    255259#endif 
    256260#if defined key_bdy 
Note: See TracChangeset for help on using the changeset viewer.