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 5433 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90 – NEMO

Ignore:
Timestamp:
2015-06-18T08:37:20+02:00 (9 years ago)
Author:
deazer
Message:

Corrected loop order, and changed variable names, checked with sette , ok
new output also ok.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r5260 r5433  
    88   USE oce             ! ocean dynamics and tracers variables 
    99   USE dom_oce         ! ocean space and time domain 
    10    USE diainsitutem, ONLY: insitu_t, theta2t 
     10   USE diainsitutem, ONLY: rinsitu_t, theta2t 
    1111   USE in_out_manager  ! I/O units 
    1212   USE iom             ! I/0 library 
     
    2828 
    2929  !! * variables for calculating 25-hourly means 
    30    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, insitu_t_25h   
     30   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, rinsitu_t_25h   
    3131   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h  
    3232   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h 
     
    3636#endif 
    3737#if defined key_zdfgls  
    38    REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   mxln_25h 
     38   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h 
    3939#endif 
    4040   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means 
     
    9494         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN 
    9595      ENDIF 
    96       ALLOCATE( insitu_t_25h(jpi,jpj,jpk), STAT=ierror ) 
    97       IF( ierror > 0 ) THEN 
    98          CALL ctl_stop( 'dia_25h: unable to allocate insitu_t_25h' )   ;   RETURN 
     96      ALLOCATE( rinsitu_t_25h(jpi,jpj,jpk), STAT=ierror ) 
     97      IF( ierror > 0 ) THEN 
     98         CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' )   ;   RETURN 
    9999      ENDIF 
    100100      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror ) 
     
    125125#endif 
    126126# if defined key_zdfgls  
    127       ALLOCATE( mxln_25h(jpi,jpj,jpk), STAT=ierror ) 
    128       IF( ierror > 0 ) THEN 
    129          CALL ctl_stop( 'dia_25h: unable to allocate mxln_25h' )   ;   RETURN 
     127      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror ) 
     128      IF( ierror > 0 ) THEN 
     129         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN 
    130130      ENDIF 
    131131#endif 
     
    141141      sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 
    142142      CALL theta2t 
    143       insitu_t_25h(:,:,:) = insitu_t(:,:,:) 
     143      rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 
    144144      sshn_25h(:,:) = sshb(:,:) 
    145145      un_25h(:,:,:) = ub(:,:,:) 
     
    152152#endif 
    153153# if defined key_zdfgls 
    154          mxln_25h(:,:,:) = mxln(:,:,:) 
     154         rmxln_25h(:,:,:) = mxln(:,:,:) 
    155155#endif 
    156156#if defined key_lim3 || defined key_lim2 
     
    200200      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace 
    201201      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace 
    202       INTEGER                          ::   nyear0, nmonth0,nday0                 ! start year,month,day 
     202      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day 
    203203 
    204204      !!---------------------------------------------------------------------- 
     
    235235         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 
    236236         CALL theta2t 
    237          insitu_t_25h(:,:,:)  = insitu_t_25h(:,:,:) + insitu_t(:,:,:) 
     237         rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:) 
    238238         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:) 
    239239         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:) 
     
    246246#endif 
    247247# if defined key_zdfgls 
    248          mxln_25h(:,:,:)      = mxln_25h(:,:,:) + mxln(:,:,:) 
     248         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    249249#endif 
    250250         cnt_25h = cnt_25h + 1 
     
    266266            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp 
    267267            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
    268             insitu_t_25h(:,:,:)  = insitu_t_25h(:,:,:) / 25.0_wp 
     268            rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) / 25.0_wp 
    269269            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
    270270            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
     
    277277#endif 
    278278# if defined key_zdfgls 
    279             mxln_25h(:,:,:)       = mxln_25h(:,:,:) / 25.0_wp 
     279            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
    280280#endif 
    281281 
     
    286286            CALL iom_put("temper25h", zw3d)   ! potential temperature 
    287287            CALL theta2t                                                                    ! calculate insitu temp 
    288             zw3d(:,:,:) = insitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     288            zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    289289            CALL iom_put("tempis25h", zw3d)   ! in-situ temperature 
    290290            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     
    311311#endif 
    312312#if defined key_zdfgls  
    313             zw3d(:,:,:) = mxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     313            zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    314314            CALL iom_put( "mxln25h",zw3d) 
    315315#endif 
     
    319319            sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 
    320320            CALL theta2t 
    321             insitu_t_25h(:,:,:) = insitu_t(:,:,:) 
     321            rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:) 
    322322            sshn_25h(:,:) = sshn (:,:) 
    323323            un_25h(:,:,:) = un(:,:,:) 
     
    330330#endif 
    331331# if defined key_zdfgls 
    332             mxln_25h(:,:,:) = mxln(:,:,:) 
     332            rmxln_25h(:,:,:) = mxln(:,:,:) 
    333333#endif 
    334334            cnt_25h = 1 
Note: See TracChangeset for help on using the changeset viewer.