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 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r1948 r2528  
    44   !! AR5 diagnostics 
    55   !!====================================================================== 
    6    !! History : 3.2  !  2009-11  (S. Masson)  Original code 
     6   !! History :  3.2  !  2009-11  (S. Masson)  Original code 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_diaar5 
     
    1011   !!   'key_diaar5'  :                           activate ar5 diagnotics 
    1112   !!---------------------------------------------------------------------- 
    12    !!   exa_mpl       : liste of module subroutine (caution, never use the 
    13    !!   exa_mpl_init  : name of the module for a routine) 
    14    !!   exa_mpl_stp   : Please try to use 3 letter block for routine names 
     13   !!   dia_ar5       : AR5 diagnostics 
     14   !!   dia_ar5_init  : initialisation of AR5 diagnostics 
    1515   !!---------------------------------------------------------------------- 
    1616   USE oce            ! ocean dynamics and active tracers  
    1717   USE dom_oce        ! ocean space and time domain 
    18    USE eosbn2          ! equation of state                (eos_bn2 routine) 
     18   USE eosbn2         ! equation of state                (eos_bn2 routine) 
    1919   USE lib_mpp        ! distribued memory computing library 
    2020   USE iom            ! I/O manager library 
     
    2323   PRIVATE 
    2424 
    25    PUBLIC   dia_ar5   ! routine called in step.F90 module 
     25   PUBLIC   dia_ar5        ! routine called in step.F90 module 
     26   PUBLIC   dia_ar5_init   ! routine called in opa.F90 module 
    2627 
    2728   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag 
    2829 
    29    REAL(wp)                         ::   vol0               ! ocean volume (interior domain) 
    30    REAL(wp)                         ::   area_tot           ! total ocean surface (interior domain) 
    31    REAL(wp), DIMENSION(jpi,jpj    ) ::   area               ! cell surface (interior domain) 
    32    REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0             ! ocean thickness (interior domain) 
    33    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0                ! initial salinity 
     30   REAL(wp)                         ::   vol0         ! ocean volume (interior domain) 
     31   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain) 
     32   REAL(wp), DIMENSION(jpi,jpj    ) ::   area         ! cell surface (interior domain) 
     33   REAL(wp), DIMENSION(jpi,jpj    ) ::   thick0       ! ocean thickness (interior domain) 
     34   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sn0          ! initial salinity 
    3435       
    3536   !! * Substitutions 
    3637#  include "domzgr_substitute.h90" 
    3738   !!---------------------------------------------------------------------- 
    38    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    39    !! $Id$  
    40    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     39   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     40   !! $Id$ 
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4343CONTAINS 
    4444 
     
    4747      !!                    ***  ROUTINE dia_ar5  *** 
    4848      !! 
    49       !! ** Purpose :   Brief description of the routine 
     49      !! ** Purpose :   compute and output some AR5 diagnostics 
    5050      !! 
    51       !! ** Method  :   description of the methodoloy used to achieve the 
    52       !!                objectives of the routine. Be as clear as possible! 
    53       !! 
    54       !! ** Action  : - first action (share memory array/varible modified 
    55       !!                in this routine 
    56       !!              - second action ..... 
    57       !!              - ..... 
    58       !! 
    59       !! References :   Author et al., Short_name_review, Year 
    60       !!                Give references if exist otherwise suppress these lines 
    6151      !!---------------------------------------------------------------------- 
    6252      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     
    6656      REAL(wp), DIMENSION(jpi,jpj    ) ::   zarea_ssh, zbotpres 
    6757      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zrhd, zrhop 
     58      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) ::   ztsn 
    6859      !!-------------------------------------------------------------------- 
    69  
    70       IF( kt == nit000  )   CALL dia_ar5_init   ! Initialization (first time-step only) 
    7160 
    7261      CALL iom_put( 'cellthc', fse3t(:,:,:) ) 
     
    8372 
    8473      !                                         ! thermosteric ssh 
    85       CALL eos( tn, sn0, zrhd )                       ! now in situ density using initial salinity 
    86       ! 
    87       zbotpres(:,:) = 0.e0                            ! no atmospheric surface pressure, levitating sea-ice 
     74      ztsn(:,:,:,jp_tem) = tn (:,:,:) 
     75      ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
     76      CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity 
     77      ! 
     78      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    8879      DO jk = 1, jpkm1 
    8980         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    9081      END DO 
    91       IF( .NOT. lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     82      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
    9283      !                                          
    9384      zarho = SUM( area(:,:) * zbotpres(:,:) )  
     
    9788       
    9889      !                                         ! steric sea surface height 
    99       CALL eos( tn, sn, zrhd, zrhop )                 ! now in situ and potential density 
    100       zrhop(:,:,jpk) = 0.e0 
     90      CALL eos( tsn, zrhd, zrhop )                 ! now in situ and potential density 
     91      zrhop(:,:,jpk) = 0._wp 
    10192      CALL iom_put( 'rhop', zrhop ) 
    10293      ! 
    103       zbotpres(:,:) = 0.e0                            ! no atmospheric surface pressure, levitating sea-ice 
     94      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    10495      DO jk = 1, jpkm1 
    10596         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
    10697      END DO 
    107       IF( .NOT. lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     98      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
    10899      !     
    109100      zarho = SUM( area(:,:) * zbotpres(:,:) )  
     
    113104       
    114105      !                                         ! ocean bottom pressure 
    115       zztmp = rau0 * grav * 1.e-4                     ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
     106      zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    116107      zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
    117108      CALL iom_put( 'botpres', zbotpres ) 
    118109 
    119110      !                                         ! Mean density anomalie, temperature and salinity 
    120       ztemp = 0.e0 
    121       zsal  = 0.e0 
     111      ztemp = 0._wp 
     112      zsal  = 0._wp 
    122113      DO jk = 1, jpkm1 
    123114         DO jj = 1, jpj 
    124115            DO ji = 1, jpi 
    125116               zztmp = area(ji,jj) * fse3t(ji,jj,jk) 
    126                ztemp = ztemp + zztmp * tn  (ji,jj,jk) 
    127                zsal  = zsal  + zztmp * sn  (ji,jj,jk) 
     117               ztemp = ztemp + zztmp * tn(ji,jj,jk) 
     118               zsal  = zsal  + zztmp * sn(ji,jj,jk) 
    128119            END DO 
    129120         END DO 
    130121      END DO 
    131       IF( .NOT. lk_vvl ) THEN 
    132          ztemp = ztemp + SUM( zarea_ssh(:,:) * tn  (:,:,1) ) 
    133          zsal  = zsal  + SUM( zarea_ssh(:,:) * sn  (:,:,1) ) 
     122      IF( .NOT.lk_vvl ) THEN 
     123         ztemp = ztemp + SUM( zarea_ssh(:,:) * tn(:,:,1) ) 
     124         zsal  = zsal  + SUM( zarea_ssh(:,:) * sn(:,:,1) ) 
    134125      ENDIF 
    135126      IF( lk_mpp ) THEN   
     
    153144      !!                  ***  ROUTINE dia_ar5_init  *** 
    154145      !!                    
    155       !! ** Purpose :   initialization of .... 
    156       !! 
    157       !! ** Method  :   blah blah blah ... 
    158       !! 
    159       !! ** input   :   Namlist namexa 
    160       !! 
    161       !! ** Action  :   ...   
     146      !! ** Purpose :   initialization for AR5 diagnostic computation 
    162147      !!---------------------------------------------------------------------- 
    163148      INTEGER  ::   inum 
     
    172157      area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
    173158 
    174       vol0        = 0.e0 
    175       thick0(:,:) = 0.e0 
     159      vol0        = 0._wp 
     160      thick0(:,:) = 0._wp 
    176161      DO jk = 1, jpkm1 
    177162         vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) ) 
     
    184169      CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 ) 
    185170      CALL iom_close( inum ) 
    186       sn0(:,:,:) = 0.5 * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    187       sn0(:,:,:) = sn0(:,:,:)*tmask(:,:,:) 
     171      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     172      sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    188173      IF( ln_zps ) THEN               ! z-coord. partial steps 
    189174         DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    190175            DO ji = 1, jpi 
    191                ik = mbathy(ji,jj) - 1 
    192                IF( ik > 2 ) THEN 
     176               ik = mbkt(ji,jj) 
     177               IF( ik > 1 ) THEN 
    193178                  zztmp = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    194                   sn0(ji,jj,ik) = (1.-zztmp) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     179                  sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
    195180               ENDIF 
    196181            END DO 
     
    204189   !!   Default option :                                         NO diaar5 
    205190   !!---------------------------------------------------------------------- 
    206  
    207191   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE.   ! coupled flag 
    208  
    209192CONTAINS 
    210  
     193   SUBROUTINE dia_ar5_init    ! Dummy routine 
     194   END SUBROUTINE dia_ar5_init 
    211195   SUBROUTINE dia_ar5( kt )   ! Empty routine 
    212       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     196      INTEGER ::   kt 
    213197      WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt 
    214198   END SUBROUTINE dia_ar5 
Note: See TracChangeset for help on using the changeset viewer.