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 4161 for branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90 – NEMO

Ignore:
Timestamp:
2013-11-07T11:01:27+01:00 (10 years ago)
Author:
cetlod
Message:

dev_LOCEAN_2013 : merge in the 3rd dev branch dev_r4028_CNRS_LIM3, see ticket #1169

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r4148 r4161  
    1010   !!                 !                  + simplification of the ice-ocean stress calculation 
    1111   !!            3.4  ! 2011-02 (G. Madec) dynamical allocation 
     12   !!             -   ! 2012    (D. Iovino) salt flux change 
     13   !!             -   ! 2012-05 (C. Rousset) add penetration solar flux 
    1214   !!            3.5  ! 2012-10 (A. Coward, G. Madec) salt fluxes ; ice+snow mass 
    1315   !!---------------------------------------------------------------------- 
     
    3537   USE prtctl           ! Print control 
    3638   USE cpl_oasis3, ONLY : lk_cpl 
     39   USE traqsr           ! clem: add penetration of solar flux into the calculation of heat budget 
    3740   USE oce,        ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass, sshu_b, sshv_b, sshu_n, sshv_n, sshf_n 
    3841   USE dom_ice,    ONLY : tms 
     
    5760#  include "vectopt_loop_substitute.h90" 
    5861   !!---------------------------------------------------------------------- 
    59    !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011) 
     62   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 
    6063   !! $Id$ 
    6164   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    99102      INTEGER, INTENT(in) ::   kt    ! number of iteration 
    100103      ! 
    101       INTEGER  ::   ji, jj           ! dummy loop indices 
     104      INTEGER  ::   ji, jj, jl           ! dummy loop indices 
    102105      INTEGER  ::   ierr, ifvt, i1mfr, idfr           ! local integer 
    103106      INTEGER  ::   iflt, ial , iadv , ifral, ifrdv   !   -      - 
     
    106109      REAL(wp) ::   zfcm1 , zfcm2                     !   -      - 
    107110      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp     ! 2D/3D workspace 
     111      REAL(wp) ::   zzfcm1, zfscmbq ! clem: for light penetration 
    108112      !!--------------------------------------------------------------------- 
    109113       
     
    119123         DO ji = 1, jpi 
    120124            zinda   = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) ) 
    121             ifvt    = zinda  *  MAX( rzero , SIGN( rone, -phicif  (ji,jj) ) )  !subscripts are bad here 
    122             i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( at_i(ji,jj)       ) ) ) 
     125            ifvt    = zinda  *  MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )  !subscripts are bad here 
     126            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - at_i(ji,jj) ) ) 
    123127            idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(ji,jj) ) - pfrld(ji,jj) ) ) 
    124128            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt ) 
     
    141145 
    142146            !   computation the solar flux at ocean surface 
    143             zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) 
     147            IF (lk_cpl) THEN ! be carfeful: not being tested yet 
     148               ! original line 
     149               !zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) 
     150               ! new line to include solar penetration (not tested) 
     151               zfcm1 = qsr_tot(ji,jj) + fstric(ji,jj) * at_i(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     152               DO jl = 1, jpl 
     153                  zfcm1 = zfcm1 - qsr_ice(ji,jj,jl) * a_i(ji,jj,jl) 
     154               END DO 
     155            ELSE 
     156               zfcm1   = pfrld(ji,jj) * qsr(ji,jj)  + & 
     157                    &    ( 1._wp - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     158            ENDIF 
    144159            ! fstric     Solar flux transmitted trough the ice 
    145160            ! qsr        Net short wave heat flux on free ocean 
    146161            ! new line 
    147             fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
     162            fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) / ( 1.0 - zinda + zinda * iatte(ji,jj) ) 
     163 
     164            ! solar flux and fscmbq with light penetration (clem) 
     165            zzfcm1  = pfrld(ji,jj) * qsr(ji,jj) * oatte(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj) 
     166            zfscmbq = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj) 
    148167 
    149168            !  computation the non solar heat flux at ocean surface 
    150             zfcm2 = - zfcm1                                                                     & ! ??? 
    151                &    + iflt    * fscmbq(ji,jj)                                                   & ! total ablation: heat given to the ocean 
     169            zfcm2 = - zzfcm1                                                                    & ! 
     170               &    + iflt    * zfscmbq                                                         & ! total ablation: heat given to the ocean 
    152171               &    + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   & 
    153172               &    + ifrdv   * (       qfvbq(ji,jj) +             qdtcn(ji,jj) ) * r1_rdtice   & 
     
    170189            !                           ! fdtcn : turbulent oceanic heat flux 
    171190 
    172 !!gm   this IF prevents the vertorisation of the whole loop 
    173             IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
    174                WRITE(numout,*) ' lim_sbc : heat fluxes ' 
    175                WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
    176                WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
    177                WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
    178                WRITE(numout,*) 
    179                WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
    180                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    181                WRITE(numout,*) ' ifral     : ', ifral 
    182                WRITE(numout,*) ' ial       : ', ial   
    183                WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
    184                WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
    185                WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
    186                WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
    187                WRITE(numout,*) ' ifrdv     : ', ifrdv 
    188                WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
    189                WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
    190                WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
    191                WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
    192                WRITE(numout,*) ' ' 
    193                WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
    194                WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
    195                WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 
    196                WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
    197                WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
    198             ENDIF 
    199 !!gm   end 
     191            !!gm   this IF prevents the vertorisation of the whole loop 
     192          !  IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN 
     193          !     WRITE(numout,*) ' lim_sbc : heat fluxes ' 
     194          !     WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx) 
     195          !     WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx) 
     196          !     WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx) 
     197          !     WRITE(numout,*) 
     198          !     WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx) 
     199          !     WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
     200          !     WRITE(numout,*) ' ifral     : ', ifral 
     201          !     WRITE(numout,*) ' ial       : ', ial   
     202          !     WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx) 
     203          !     WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx) 
     204          !     !WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice 
     205          !     !WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice 
     206          !     WRITE(numout,*) ' ifrdv     : ', ifrdv 
     207          !     WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx) 
     208          !     WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx) 
     209          !     !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice 
     210          !     !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice 
     211          !     WRITE(numout,*) ' ' 
     212          !     WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx) 
     213          !     WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx) 
     214          !     WRITE(numout,*) ' fheat_mec : ', fheat_mec(jiindx,jjindx) 
     215          !     WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx) 
     216          !     WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx) 
     217          !  ENDIF 
     218            !!gm   end 
    200219         END DO 
    201220      END DO 
     
    218237 
    219238            !  computing freshwater exchanges at the ice/ocean interface 
    220             zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
    221                &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
    222                &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
    223                &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     239            IF (lk_cpl) THEN  
     240               zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
     241                  &   - rdm_snw(ji,jj) / rdt_ice 
     242            ELSE 
     243               zemp =   emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction 
     244                  &   - tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean 
     245                  &   + sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice 
     246                  &   - fmmec(ji,jj)                                         ! snow falling when ridging 
     247            ENDIF 
    224248 
    225249            ! mass flux at the ocean/ice interface (sea ice fraction) 
     
    370394      !! ** input   : Namelist namicedia 
    371395      !!------------------------------------------------------------------- 
     396      REAL(wp) :: zsum, zarea 
    372397      ! 
    373398      INTEGER  ::   ji, jj                          ! dummy loop indices 
     
    390415         END WHERE 
    391416      ENDIF 
     417      ! clem modif 
     418      iatte(:,:) = 1._wp 
     419      oatte(:,:) = 1._wp 
     420      ! 
    392421      !                                      ! embedded sea ice 
    393422      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
     
    435464      ENDIF 
    436465      ! 
     466!!?      IF( .NOT. ln_rstart ) THEN           ! delete the initial ssh below sea-ice area 
     467!!?         ! 
     468!!?         zarea     = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     469!!?         zsum      = glob_sum( e1e2t(:,:) * ( snwice_mass(:,:) ) ) / zarea * r1_rau0 
     470!!?         sshn(:,:) = sshn(:,:) - zsum  
     471!!?         sshb(:,:) = sshb(:,:) - zsum 
     472!!?      ENDIF 
     473      ! 
     474 
    437475   END SUBROUTINE lim_sbc_init 
    438476 
Note: See TracChangeset for help on using the changeset viewer.