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 10962 for branches/UKMO – NEMO

Changeset 10962 for branches/UKMO


Ignore:
Timestamp:
2019-05-10T15:46:45+02:00 (5 years ago)
Author:
rrenshaw
Message:

code fix

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis2/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r8058 r10962  
    3939   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:  ) ::   thick0       ! ocean thickness (interior domain) 
    4040   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sn0          ! initial salinity 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn0          ! initial temperature 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshthster_mat         ! ssh_thermosteric height 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshhlster_mat         ! ssh_halosteric height 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshsteric_mat         ! ssh_steric height 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zbotpres_mat          ! bottom pressure 
    4146       
    4247   !! * Substitutions 
     
    5661      !!---------------------------------------------------------------------- 
    5762      ! 
    58       ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 
     63      ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk), tn0(jpi,jpj,jpk) , & 
     64          & sshthster_mat(jpi,jpj),sshhlster_mat(jpi,jpj),sshsteric_mat(jpi,jpj), & 
     65          & zbotpres_mat(jpi,jpj),STAT=dia_ar5_alloc ) 
    5966      ! 
    6067      IF( lk_mpp             )   CALL mpp_sum ( dia_ar5_alloc ) 
     
    8592      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    8693      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
     94       
     95      sshthster_mat(:,:) = 0._wp   
     96      sshhlster_mat(:,:) = 0._wp   
     97      sshsteric_mat(:,:) = 0._wp   
     98      zbotpres_mat(:,:)  = 0._wp   
    8799 
    88100      zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
     
    121133      zssh_steric = - zarho / area_tot 
    122134      CALL iom_put( 'sshthster', zssh_steric ) 
     135      sshthster_mat(:,:) =  -zbotpres(:,:) 
     136      CALL iom_put( 'sshthster_mat', sshthster_mat ) 
     137 
     138      !                      
     139      ztsn(:,:,:,jp_tem) = tn0(:,:,:)                    ! thermohaline ssh 
     140      ztsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)  
     141      CALL eos( ztsn, zrhd, fsdept_n(:,:,:) )                       ! now in situ density using initial temperature 
     142      ! 
     143      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     144      DO jk = 1, jpkm1 
     145         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 
     146      END DO 
     147      IF( .NOT.lk_vvl ) THEN 
     148         IF ( ln_isfcav ) THEN 
     149            DO ji=1,jpi 
     150               DO jj=1,jpj 
     151                  zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 
     152               END DO 
     153            END DO 
     154         ELSE 
     155            zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     156         END IF 
     157      END IF 
     158      !                                          
     159      zarho = SUM( area(:,:) * zbotpres(:,:) )  
     160      IF( lk_mpp )   CALL mpp_sum( zarho ) 
     161      zssh_steric = - zarho / area_tot 
     162      CALL iom_put( 'sshhlster', zssh_steric ) 
     163      sshhlster_mat(:,:) = -zbotpres(:,:) 
     164      CALL iom_put( 'sshhlster_mat', sshhlster_mat ) 
     165       
     166 
    123167       
    124168      !                                         ! steric sea surface height 
     
    147191      zssh_steric = - zarho / area_tot 
    148192      CALL iom_put( 'sshsteric', zssh_steric ) 
     193      sshsteric_mat(:,:) = -zbotpres(:,:)  
     194      CALL iom_put( 'sshsteric_mat', sshsteric_mat ) 
    149195       
    150196      !                                         ! ocean bottom pressure 
    151197      zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    152198      zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
    153       CALL iom_put( 'botpres', zbotpres ) 
    154  
     199      zbotpres_mat(:,:) = zbotpres(:,:) 
     200      CALL iom_put( 'botpres', zbotpres_mat ) 
     201       
    155202      !                                         ! Mean density anomalie, temperature and salinity 
    156203      ztemp = 0._wp 
     
    211258      REAL(wp) ::   zztmp   
    212259      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
     260      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztemdta   ! Jan/Dec levitus salinity 
    213261      ! reading initial file 
    214262      LOGICAL  ::   ln_tsd_init      !: T & S data flag 
     
    234282      ! 
    235283      CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 
     284      CALL wrk_alloc( jpi , jpj , jpk, jpts, ztemdta ) 
    236285      !                                      ! allocate dia_ar5 arrays 
    237286      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
     
    253302      CALL iom_get  ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 
    254303      CALL iom_close( inum ) 
     304 
     305      CALL iom_open ( TRIM( cn_dir )//TRIM(sn_tem%clname), inum ) 
     306      CALL iom_get  ( inum, jpdom_data, TRIM(sn_tem%clvar), ztemdta(:,:,:,1), 1  ) 
     307      CALL iom_get  ( inum, jpdom_data, TRIM(sn_tem%clvar), ztemdta(:,:,:,2), 12 ) 
     308      CALL iom_close( inum ) 
    255309      sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    256       sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     310      tn0(:,:,:) = 0.5_wp * ( ztemdta(:,:,:,1) + ztemdta(:,:,:,2) )         
     311      sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:)   
     312      tn0(:,:,:) = tn0(:,:,:) * tmask(:,:,:) 
    257313      IF( ln_zps ) THEN               ! z-coord. partial steps 
    258314         DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     
    262318                  zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    263319                  sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 
     320                  tn0(ji,jj,ik) = ( 1._wp - zztmp ) * tn0(ji,jj,ik) + zztmp * tn0(ji,jj,ik-1) 
    264321               ENDIF 
    265322            END DO 
     
    268325      ! 
    269326      CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 
     327      CALL wrk_dealloc( jpi , jpj , jpk, jpts, ztemdta ) 
    270328      ! 
    271329      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init') 
Note: See TracChangeset for help on using the changeset viewer.