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 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 – NEMO

Ignore:
Timestamp:
2016-11-28T17:04:10+01:00 (7 years ago)
Author:
emanuelaclementi
Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r5643 r7351  
    4646   REAL(wp) ::   frc_wn_t, frc_wn_s    ! global forcing trends 
    4747   ! 
    48    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf          , ssh_ini          ! 
     48   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf  
     49   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   surf_ini      , ssh_ini          ! 
    4950   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   ssh_hc_loc_ini, ssh_sc_loc_ini   ! 
    5051   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  ! 
    5152 
    5253   !! * Substitutions 
    53 #  include "domzgr_substitute.h90" 
    5454#  include "vectopt_loop_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
     
    100100      IF( ln_rnf_sal)   z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 
    101101      ! Add ice shelf heat & salt input 
    102       IF( nn_isf .GE. 1 )  THEN 
    103           z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 
    104           z_frc_trd_s = z_frc_trd_s + glob_sum( risf_tsc(:,:,jp_sal) * surf(:,:) ) 
    105       ENDIF 
    106  
     102      IF( ln_isf    ) z_frc_trd_t = z_frc_trd_t + glob_sum( risf_tsc(:,:,jp_tem) * surf(:,:) ) 
    107103      ! Add penetrative solar radiation 
    108104      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr     (:,:) * surf(:,:) ) 
     
    110106      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t +               glob_sum( qgh_trd0(:,:) * surf(:,:) ) 
    111107      ! 
    112       IF( .NOT. lk_vvl ) THEN 
    113          IF ( ln_isfcav ) THEN 
     108      IF( ln_linssh ) THEN 
     109         IF( ln_isfcav ) THEN 
    114110            DO ji=1,jpi 
    115111               DO jj=1,jpj 
    116112                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_tem) 
    117113                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,mikt(ji,jj)) * tsb(ji,jj,mikt(ji,jj),jp_sal) 
    118                ENDDO 
    119             ENDDO 
     114               END DO 
     115            END DO 
    120116         ELSE 
    121117            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 
     
    130126      frc_s = frc_s + z_frc_trd_s * rdt 
    131127      !                                          ! Advection flux through fixed surface (z=0) 
    132       IF( .NOT. lk_vvl ) THEN 
     128      IF( ln_linssh ) THEN 
    133129         frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 
    134130         frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 
     
    138134      ! 2 -  Content variations ! 
    139135      ! ------------------------ ! 
     136      ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 
    140137      zdiff_v2 = 0._wp 
    141138      zdiff_hc = 0._wp 
     
    143140 
    144141      ! volume variation (calculated with ssh) 
    145       zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 
     142      zdiff_v1 = glob_sum_full( surf(:,:) * sshn(:,:) - surf_ini(:,:) * ssh_ini(:,:) ) 
    146143 
    147144      ! heat & salt content variation (associated with ssh) 
    148       IF( .NOT. lk_vvl ) THEN 
    149          IF ( ln_isfcav ) THEN 
     145      IF( ln_linssh ) THEN 
     146         IF( ln_isfcav ) THEN 
    150147            DO ji = 1, jpi 
    151148               DO jj = 1, jpj 
     
    158155            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
    159156         END IF 
    160          z_ssh_hc = glob_sum( z2d0 )  
    161          z_ssh_sc = glob_sum( z2d1 )  
     157         z_ssh_hc = glob_sum_full( z2d0 )  
     158         z_ssh_sc = glob_sum_full( z2d1 )  
    162159      ENDIF 
    163160 
    164161      DO jk = 1, jpkm1 
    165162         ! volume variation (calculated with scale factors) 
    166          zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 
    167             &                           * ( fse3t_n(:,:,jk) - e3t_ini(:,:,jk) ) ) 
     163         zdiff_v2 = zdiff_v2 + glob_sum_full( surf(:,:) * tmask(:,:,jk)            & 
     164            &                           * e3t_n(:,:,jk) - surf_ini(:,:) * e3t_ini(:,:,jk) ) 
    168165         ! heat content variation 
    169          zdiff_hc = zdiff_hc + glob_sum(  surf(:,:) * tmask(:,:,jk) &  
    170             &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - hc_loc_ini(:,:,jk) ) ) 
     166         zdiff_hc = zdiff_hc + glob_sum_full(  surf(:,:) * tmask(:,:,jk)                                  &  
     167            &                           * e3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) - surf_ini(:,:) * hc_loc_ini(:,:,jk) )  
    171168         ! salt content variation 
    172          zdiff_sc = zdiff_sc + glob_sum(  surf(:,:) * tmask(:,:,jk)   & 
    173             &                           * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - sc_loc_ini(:,:,jk) ) ) 
     169         zdiff_sc = zdiff_sc + glob_sum_full( surf    (:,:) * tmask(:,:,jk)                           & 
     170                                        * e3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) 
    174171      ENDDO 
    175172 
    176173      ! Substract forcing from heat content, salt content and volume variations 
    177174      zdiff_v1 = zdiff_v1 - frc_v 
    178       IF( lk_vvl )   zdiff_v2 = zdiff_v2 - frc_v 
     175      IF( .NOT.ln_linssh )   zdiff_v2 = zdiff_v2 - frc_v 
    179176      zdiff_hc = zdiff_hc - frc_t 
    180177      zdiff_sc = zdiff_sc - frc_s 
    181       IF( .NOT. lk_vvl ) THEN 
     178      IF( ln_linssh ) THEN 
    182179         zdiff_hc1 = zdiff_hc + z_ssh_hc  
    183180         zdiff_sc1 = zdiff_sc + z_ssh_sc 
     
    191188      zvol_tot = 0._wp                    ! total ocean volume (calculated with scale factors) 
    192189      DO jk = 1, jpkm1 
    193          zvol_tot  = zvol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) * fse3t_n(:,:,jk) ) 
     190         zvol_tot  = zvol_tot + glob_sum_full( surf(:,:) * tmask(:,:,jk) * e3t_n(:,:,jk) ) 
    194191      END DO 
    195192 
    196193!!gm to be added ? 
    197 !      IF( .NOT. lk_vvl ) THEN            ! fixed volume, add the ssh contribution 
     194!      IF( ln_linssh ) THEN            ! fixed volume, add the ssh contribution 
    198195!        zvol_tot = zvol_tot + glob_sum( surf(:,:) * sshn(:,:) ) 
    199196!      ENDIF 
    200197!!gm end 
    201198 
    202       IF( lk_vvl ) THEN 
     199      IF( ln_linssh ) THEN 
     200        CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C)  
     201        CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
     202        CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J)  
     203        CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9   )              ! Salt content variation (psu*km3) 
     204        CALL iom_put( 'bgvolssh' , zdiff_v1  * 1.e-9   )              ! volume ssh variation (km3)   
     205        CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
     206        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
     207        CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
     208        CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C) 
     209        CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu) 
     210      ELSE 
    203211        CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot )              ! Temperature variation (C)  
    204212        CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot )              ! Salinity    variation (psu) 
     
    210218        CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
    211219        CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
    212       ELSE 
    213         CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot)              ! Heat content variation (C)  
    214         CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot)              ! Salt content variation (psu) 
    215         CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp )  ! Heat content variation (1.e20 J)  
    216         CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9    )             ! Salt content variation (psu*km3) 
    217         CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9    )              ! volume ssh variation (km3)   
    218         CALL iom_put( 'bgfrcvol' , frc_v    * 1.e-9    )              ! vol - surface forcing (km3)  
    219         CALL iom_put( 'bgfrctem' , frc_t / zvol_tot    )              ! hc  - surface forcing (C)  
    220         CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot    )              ! sc  - surface forcing (psu)  
    221         CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot )              ! hc  - error due to free surface (C) 
    222         CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot )              ! sc  - error due to free surface (psu) 
    223220      ENDIF 
    224221      ! 
    225222      IF( lrst_oce )   CALL dia_hsb_rst( kt, 'WRITE' ) 
    226  
     223      ! 
    227224      CALL wrk_dealloc( jpi,jpj,   z2d0, z2d1 ) 
    228  
     225      ! 
    229226      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb') 
    230227      ! 
     
    257254           CALL iom_get( numror, 'frc_t', frc_t ) 
    258255           CALL iom_get( numror, 'frc_s', frc_s ) 
    259            IF( .NOT. lk_vvl ) THEN 
     256           IF( ln_linssh ) THEN 
    260257              CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
    261258              CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
    262259           ENDIF 
     260           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    263261           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini ) 
    264262           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini ) 
    265263           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini ) 
    266264           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini ) 
    267            IF( .NOT. lk_vvl ) THEN 
     265           IF( ln_linssh ) THEN 
    268266              CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    269267              CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     
    273271          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    274272          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    275           ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
     273          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     274          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
    276275          DO jk = 1, jpk 
    277              e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
    278              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
    279              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
     276             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     277             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     278             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
     279             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
    280280          END DO 
    281281          frc_v = 0._wp                                           ! volume       trend due to forcing 
    282282          frc_t = 0._wp                                           ! heat content   -    -   -    -    
    283283          frc_s = 0._wp                                           ! salt content   -    -   -    -         
    284           IF( .NOT. lk_vvl ) THEN 
     284          IF( ln_linssh ) THEN 
    285285             IF ( ln_isfcav ) THEN 
    286286                DO ji=1,jpi 
     
    308308        CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
    309309        CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
    310         IF( .NOT. lk_vvl ) THEN 
     310        IF( ln_linssh ) THEN 
    311311           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
    312312           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
    313313        ENDIF 
     314        CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini )      ! ice sheet coupling 
    314315        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    315316        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
    316317        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
    317318        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
    318         IF( .NOT. lk_vvl ) THEN 
     319        IF( ln_linssh ) THEN 
    319320           CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    320321           CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     
    379380      ! 1 - Allocate memory ! 
    380381      ! ------------------- ! 
    381       ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 
    382          &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror ) 
     382      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), & 
     383         &      e3t_ini(jpi,jpj,jpk), surf(jpi,jpj),  ssh_ini(jpi,jpj), STAT=ierror  ) 
    383384      IF( ierror > 0 ) THEN 
    384385         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
    385386      ENDIF 
    386387 
    387       IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
     388      IF( ln_linssh )  ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 
    388389      IF( ierror > 0 ) THEN 
    389390         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN 
Note: See TracChangeset for help on using the changeset viewer.