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 8059 for branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90 – NEMO

Ignore:
Timestamp:
2017-05-23T10:32:39+02:00 (7 years ago)
Author:
jgraham
Message:

Merged branches required for AMM15 simulations, see ticket #1904.
Merged branches include:
branches/UKMO/CO6_KD490
branches/UKMO/CO6_Restartable_Tidal_Analysis
branches/UKMO/AMM15_v3_6_STABLE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r8058 r8059  
    4646   LOGICAL , PUBLIC ::   ln_qsr_ice   !: light penetration for ice-model LIM3 (clem) 
    4747   INTEGER , PUBLIC ::   nn_chldta    !: use Chlorophyll data (=1) or not (=0) 
     48   INTEGER , PUBLIC ::   nn_kd490dta  !: use kd490dta data (=1) or not (=0) 
    4849   REAL(wp), PUBLIC ::   rn_abs       !: fraction absorbed in the very near surface (RGB & 2 bands) 
    4950   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
     
    5455   REAL(wp) ::   xsi1r                           !: inverse of rn_si1 
    5556   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     57   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_kd490 ! structure of input kd490 (file informations, fields read) 
    5658   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    5759   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
     
    306308            ! 
    307309         ENDIF 
     310! slwa 
     311         IF( nn_kd490dta == 1 ) THEN                      !  use KD490 data read in   ! 
     312            !                                             ! ------------------------- ! 
     313               nksr = jpk - 1 
     314               ! 
     315               CALL fld_read( kt, 1, sf_kd490 )     ! Read kd490 data and provide it at the current time step 
     316               ! 
     317               zcoef  = ( 1. - rn_abs ) 
     318               ze0(:,:,1) = rn_abs  * qsr(:,:) 
     319               ze1(:,:,1) = zcoef * qsr(:,:) 
     320               zea(:,:,1) =         qsr(:,:) 
     321               ! 
     322               DO jk = 2, nksr+1 
     323!CDIR NOVERRCHK 
     324                  DO jj = 1, jpj 
     325!CDIR NOVERRCHK    
     326                     DO ji = 1, jpi 
     327                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     ) 
     328                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) ) 
     329                        ze0(ji,jj,jk) = zc0 
     330                        ze1(ji,jj,jk) = zc1 
     331                        zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk) 
     332                     END DO 
     333                  END DO 
     334               END DO 
     335               ! clem: store attenuation coefficient of the first ocean level 
     336               IF ( ln_qsr_ice ) THEN 
     337                  DO jj = 1, jpj 
     338                     DO ji = 1, jpi 
     339                        zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r     ) 
     340                        zzc1 = zcoef  * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) ) 
     341                        fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2)  
     342                     END DO 
     343                  END DO 
     344               ENDIF 
     345               ! 
     346               DO jk = 1, nksr                                        ! compute and add qsr trend to ta 
     347                  qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
     348               END DO 
     349               zea(:,:,nksr+1:jpk) = 0.e0     !  
     350               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution 
     351               ! 
     352        ENDIF   ! use KD490 data 
     353!slwa 
    308354         ! 
    309355         !                                        Add to the general trend 
     
    374420      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    375421      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    376       !! 
    377       NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    378          &                  nn_chldta, rn_abs, rn_si0, rn_si1 
     422      TYPE(FLD_N)        ::   sn_kd490 ! informations about the kd490 field to be read 
     423      !! 
     424      NAMELIST/namtra_qsr/  sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
     425         &                  nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 
    379426      !!---------------------------------------------------------------------- 
    380427 
     
    409456         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    410457         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
     458         WRITE(numout,*) '      read in KD490 data                       nn_kd490dta  = ', nn_kd490dta 
    411459      ENDIF 
    412460 
     
    422470         IF( ln_qsr_2bd  )   ioptio = ioptio + 1 
    423471         IF( ln_qsr_bio  )   ioptio = ioptio + 1 
     472         IF( nn_kd490dta == 1 )   ioptio = ioptio + 1 
    424473         ! 
    425474         IF( ioptio /= 1 ) & 
     
    431480         IF( ln_qsr_2bd                      )   nqsr =  3 
    432481         IF( ln_qsr_bio                      )   nqsr =  4 
     482         IF( nn_kd490dta == 1                )   nqsr =  5 
    433483         ! 
    434484         IF(lwp) THEN                   ! Print the choice 
     
    438488            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration' 
    439489            IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration' 
     490            IF( nqsr ==  5 )   WRITE(numout,*) '         KD490 light penetration' 
    440491         ENDIF 
    441492         ! 
     
    447498         xsi0r = 1.e0 / rn_si0 
    448499         xsi1r = 1.e0 / rn_si1 
     500         IF( nn_kd490dta == 1 ) THEN           !* KD490 data : set sf_kd490 structure 
     501            IF(lwp) WRITE(numout,*) 
     502            IF(lwp) WRITE(numout,*) '        KD490 read in a file' 
     503            ALLOCATE( sf_kd490(1), STAT=ierror ) 
     504            IF( ierror > 0 ) THEN 
     505               CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' )   ;   RETURN 
     506            ENDIF 
     507            ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1)   ) 
     508            IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) ) 
     509            !                                        ! fill sf_kd490 with sn_kd490 and control print 
     510            CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init',   & 
     511               &                                         'Solar penetration function of read KD490', 'namtra_qsr' ) 
    449512         !                                ! ---------------------------------- ! 
    450          IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  ! 
     513         ELSEIF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  ! 
    451514            !                             ! ---------------------------------- ! 
    452515            ! 
Note: See TracChangeset for help on using the changeset viewer.