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

Changeset 8561


Ignore:
Timestamp:
2017-09-22T17:45:41+02:00 (6 years ago)
Author:
jgraham
Message:

Updates for operational diagnostics:
25h mean diagnostics - bottom temperature (and insitu temp)
Operational foam diagnostics - diaopfoam and DIU routines added.

Location:
branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC
Files:
5 added
6 edited

Legend:

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

    r8059 r8561  
    2020   USE zdf_oce, ONLY: en 
    2121#endif 
     22   USE diatmb 
    2223 
    2324   IMPLICIT NONE 
     
    3031  !! * variables for calculating 25-hourly means 
    3132   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, rinsitu_t_25h   
    32    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h  
     33   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h, insitu_bot_25h, temp_bot_25h  
    3334   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h 
    3435   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h 
     
    6364      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6465      INTEGER ::   ierror              ! Local integer for memory allocation 
     66      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    6567      ! 
    6668      NAMELIST/nam_dia25h/ ln_dia25h 
     
    99101         CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' )   ;   RETURN 
    100102      ENDIF 
     103      ALLOCATE( insitu_bot_25h(jpi,jpj), STAT=ierror ) 
     104      IF( ierror > 0 ) THEN 
     105         CALL ctl_stop( 'dia_25h: unable to allocate insitu_bot_25h' )   ;   RETURN 
     106      ENDIF       
     107      ALLOCATE( temp_bot_25h(jpi,jpj), STAT=ierror ) 
     108      IF( ierror > 0 ) THEN 
     109         CALL ctl_stop( 'dia_25h: unable to allocate temp_bot_25h' )   ;   RETURN 
     110      ENDIF                            
    101111      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror ) 
    102112      IF( ierror > 0 ) THEN 
     
    143153      CALL theta2t 
    144154      rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 
     155      CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb ) 
     156      insitu_bot_25h(:,:) = zwtmb(:,:,3) 
     157      CALL dia_calctmb( tn_25h(:,:,:),zwtmb ) 
     158      temp_bot_25h(:,:) = zwtmb(:,:,3) 
    145159      sshn_25h(:,:) = sshb(:,:) 
    146160      un_25h(:,:,:) = ub(:,:,:) 
     
    237251         CALL theta2t 
    238252         rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:) 
     253         CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb ) 
     254         insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) + zwtmb(:,:,3) 
     255         zw3d(:,:,:)          = tsn(:,:,:,jp_tem) 
     256         CALL dia_calctmb( zw3d,zwtmb ) 
     257         temp_bot_25h(:,:)    = temp_bot_25h(:,:) + zwtmb(:,:,3) 
    239258         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:) 
    240259         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:) 
     
    268287            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
    269288            rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) / 25.0_wp 
     289            insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) / 25.0_wp  
     290            temp_bot_25h(:,:)    = temp_bot_25h(:,:) /25.0_wp 
    270291            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
    271292            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
     
    289310            zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    290311            CALL iom_put("tempis25h", zw3d)   ! in-situ temperature 
     312            zw2d(:,:) = insitu_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     313            CALL iom_put("tempisbot25h", zw2d) ! bottom in-situ temperature 
     314            zw2d(:,:) = temp_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     315            CALL iom_put("temperbot25h",zw2d) ! bottom potential temperature 
    291316            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    292317            CALL iom_put( "salin25h", zw3d  )   ! salinity 
     
    321346            CALL theta2t 
    322347            rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 
     348            CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb ) 
     349            insitu_bot_25h(:,:) = zwtmb(:,:,3) 
     350            CALL dia_calctmb( tn_25h(:,:,:),zwtmb) 
     351            temp_bot_25h(:,:) = zwtmb(:,:,3) 
    323352            sshn_25h(:,:) = sshn (:,:) 
    324353            un_25h(:,:,:) = un(:,:,:) 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

    r8059 r8561  
    1919   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90 
    2020   PUBLIC   dia_tmb                 ! routine called by diawri.F90 
     21   PUBLIC   dia_calctmb             ! routine called by dia25h.F90 
    2122 
    2223   !!---------------------------------------------------------------------- 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r8059 r8561  
    4646   USE diatmb          ! Top,middle,bottom output 
    4747   USE dia25h          ! 25h Mean output 
     48   USE diaopfoam       ! Diaopfoam output 
    4849   USE iom 
    4950   USE ioipsl 
     
    401402      IF (ln_dia25h) THEN 
    402403         CALL dia_25h( kt ) 
     404      ENDIF 
     405      IF (ln_diaopfoam) THEN 
     406         CALL dia_diaopfoam 
    403407      ENDIF 
    404408      ! 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8059 r8561  
    8787   USE diatmb          ! Top,middle,bottom output 
    8888   USE dia25h          ! 25h mean output 
     89   USE diaopfoam       ! FOAM operational output 
     90   USE diurnal_bulk    ! diurnal bulk SST  
    8991 
    9092   IMPLICIT NONE 
     
    405407                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    406408 
     409      CALL diurnal_sst_bulk_init                ! diurnal sst 
     410      IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init   ! cool skin   
     411 
    407412      IF( lk_tide       )   CALL    tide_init( nit000 )    ! Initialisation of the tidal harmonics 
    408413 
     
    479484                            CALL dia_tmb_init  ! TMB outputs 
    480485                            CALL dia_25h_init  ! 25h mean  outputs 
     486                            CALL dia_diaopfoam_init  ! FOAM operational output 
    481487      ! 
    482488   END SUBROUTINE nemo_init 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/step.F90

    r8059 r8561  
    225225      ENDIF 
    226226 
     227      ! Cool skin 
     228      IF ( ln_diurnal ) THEN   
     229         IF ( ln_blk_core ) THEN 
     230            CALL diurnal_sst_coolskin_step( &   
     231                    qns(:,:)+(rn_abs*qsr(:,:)), taum, rhop(:,:,1), rdt)  
     232         ELSE 
     233            CALL diurnal_sst_coolskin_step( &   
     234                    qns, taum, rhop(:,:,1), rdt)  
     235         ENDIF 
     236      ENDIF 
     237 
    227238      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    228239      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
     
    237248      ! 
    238249      IF( ln_crs     )      CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
     250 
     251      !Diurnal warm layer model         
     252      IF ( ln_diurnal ) THEN 
     253         IF ( ln_blk_core ) THEN 
     254            IF( kstp == nit000 )THEN   
     255               CALL diurnal_sst_takaya_step( &   
     256               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), & 
     257               &    taum, rhop(:,:,1), & 
     258               &    rdt, ld_calcfrac = .TRUE.)   
     259            ELSE   
     260               CALL diurnal_sst_takaya_step( &   
     261               &    qsr(:,:)-(rn_abs*qsr(:,:)), qns(:,:)+(rn_abs*qsr(:,:)), & 
     262               &    taum, rhop(:,:,1), rdt )   
     263            ENDIF  
     264         ELSE 
     265            IF( kstp == nit000 )THEN   
     266               CALL diurnal_sst_takaya_step( &   
     267               &    qsr, qns, taum, rhop(:,:,1), & 
     268               &    rdt, ld_calcfrac = .TRUE.)   
     269            ELSE   
     270               CALL diurnal_sst_takaya_step( &   
     271               &    qsr, qns, taum, rhop(:,:,1), rdt )   
     272            ENDIF  
     273         ENDIF 
     274      ENDIF 
    239275 
    240276#if defined key_top 
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r8059 r8561  
    112112   USE diaobs           ! Observation operator 
    113113 
     114   USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)   
     115   USE cool_skin       ! diurnal cool skin correction (diurnal_sst_coolskin routine) 
     116 
    114117   USE timing           ! Timing 
    115118 
Note: See TracChangeset for help on using the changeset viewer.