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/OPA_SRC/TRA/traqsr.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/OPA_SRC/TRA/traqsr.F90

    r4147 r4161  
    1010   !!             -   !  2005-11  (G. Madec) zco, zps, sco coordinate 
    1111   !!            3.2  !  2009-04  (G. Madec & NEMO team)  
     12   !!            4.0  !  2012-05  (C. Rousset) store attenuation coef for use in ice model  
    1213   !!---------------------------------------------------------------------- 
    1314 
     
    2728   USE iom             ! I/O manager 
    2829   USE fldread         ! read input fields 
     30   USE restart         ! ocean restart 
    2931   USE lib_mpp         ! MPP library 
    3032   USE wrk_nemo       ! Memory Allocation 
     
    4749   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    4850   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
     51   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
     52 
    4953    
    5054   ! Module variables 
     
    99103      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars 
    100104      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         - 
     105      REAL(wp) ::   zzc0, zzc1, zzc2, zzc3   !    -         - 
    101106      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         - 
    102107      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr 
     
    158163         END DO 
    159164         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
     165         ! clem: store attenuation coefficient of the first ocean level 
     166         IF ( ln_qsr_ice ) THEN 
     167            DO jj = 1, jpj 
     168               DO ji = 1, jpi 
     169                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
     170                     oatte(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     171                     iatte(ji,jj) = oatte(ji,jj) 
     172                  ENDIF 
     173               END DO 
     174            END DO 
     175         ENDIF 
    160176         !                                        ! ============================================== ! 
    161177      ELSE                                        !  Ocean alone :  
     
    216232                  END DO 
    217233               END DO 
     234               ! clem: store attenuation coefficient of the first ocean level 
     235               IF ( ln_qsr_ice ) THEN 
     236                  DO jj = 1, jpj 
     237                     DO ji = 1, jpi 
     238                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     239                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 
     240                        zzc2 = zcoef  * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) 
     241                        zzc3 = zcoef  * EXP( - fse3t(ji,jj,1) * zekr(ji,jj) ) 
     242                        oatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zzc2  + zzc3  ) * tmask(ji,jj,2)  
     243                        iatte(ji,jj) = 1.0 - ( zzc0 + zzc1 + zcoef + zcoef ) * tmask(ji,jj,2) 
     244                     END DO 
     245                  END DO 
     246               ENDIF 
    218247               ! 
    219248               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
     
    227256                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:) 
    228257               END DO 
    229             ENDIF 
     258               ! clem: store attenuation coefficient of the first ocean level 
     259               IF ( ln_qsr_ice ) THEN 
     260                  oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
     261                  iatte(:,:) = oatte(:,:) 
     262               ENDIF 
     263           ENDIF 
    230264 
    231265         ENDIF 
     
    246280                  END DO 
    247281               END DO 
     282               ! clem: store attenuation coefficient of the first ocean level 
     283               IF ( ln_qsr_ice ) THEN 
     284                  DO jj = 1, jpj 
     285                     DO ji = 1, jpi 
     286                        zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 
     287                        zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 
     288                        oatte(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 
     289                        iatte(ji,jj) = oatte(ji,jj) 
     290                     END DO 
     291                  END DO 
     292               ENDIF 
    248293            ELSE                                               !* constant volume: coef. computed one for all 
    249294               DO jk = 1, nksr 
     
    254299                  END DO 
    255300               END DO 
     301               ! clem: store attenuation coefficient of the first ocean level 
     302               IF ( ln_qsr_ice ) THEN 
     303                  oatte(:,:) = etot3(:,:,1) / r1_rau0_rcp 
     304                  iatte(:,:) = oatte(:,:) 
     305               ENDIF 
    256306               ! 
    257307            ENDIF 
     
    270320         ! 
    271321      ENDIF 
     322      ! clem: store attenuation coefficient of the first ocean level 
     323      !IF (ln_traqsr) THEN 
     324      !   DO jj = 1, jpj 
     325      !      DO ji = 1, jpi 
     326      !         IF ( qsr(ji,jj) /= 0._wp ) THEN 
     327      !            oatte(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     328      !            iatte(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 
     329      !         ENDIF 
     330      !      END DO 
     331      !   END DO 
     332      !END IF 
    272333      ! 
    273334      IF( lrst_oce ) THEN   !                  Write in the ocean restart file 
     
    326387      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    327388      !! 
    328       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
     389      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    329390         &                  nn_chldta, rn_abs, rn_si0, rn_si1 
    330391      !!---------------------------------------------------------------------- 
     
    332393      ! 
    333394      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
     395      ! 
     396      ! clem init for oatte and iatte 
     397      oatte(:,:) = 1._wp 
     398      iatte(:,:) = 1._wp 
    334399      ! 
    335400      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
     
    355420         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    356421         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     422         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice 
    357423         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
    358424         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    359425         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    360426         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
     427         WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice     
    361428      ENDIF 
    362429 
Note: See TracChangeset for help on using the changeset viewer.