Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (5 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r5034 r5600  
    3232   USE wrk_nemo       ! Memory Allocation 
    3333   USE timing         ! Timing 
    34    USE sbc_ice, ONLY : lk_lim3 
    3534 
    3635   IMPLICIT NONE 
     
    3837 
    3938   PUBLIC   tra_qsr       ! routine called by step.F90 (ln_traqsr=T) 
    40    PUBLIC   tra_qsr_init  ! routine called by opa.F90 
     39   PUBLIC   tra_qsr_init  ! routine called by nemogcm.F90 
    4140 
    4241   !                                 !!* Namelist namtra_qsr: penetrative solar radiation 
     
    5049   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    5150   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
    52     
     51  
    5352   ! Module variables 
    5453   REAL(wp) ::   xsi0r                           !: inverse of rn_si0 
     
    165164         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution 
    166165         ! clem: store attenuation coefficient of the first ocean level 
    167          IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     166         IF ( ln_qsr_ice ) THEN 
    168167            DO jj = 1, jpj 
    169168               DO ji = 1, jpi 
    170169                  IF ( qsr(ji,jj) /= 0._wp ) THEN 
    171170                     fraqsr_1lev(ji,jj) = ( qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) ) 
     171                  ELSE 
     172                     fraqsr_1lev(ji,jj) = 1. 
    172173                  ENDIF 
    173174               END DO 
     
    233234               END DO 
    234235               ! clem: store attenuation coefficient of the first ocean level 
    235                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     236               IF ( ln_qsr_ice ) THEN 
    236237                  DO jj = 1, jpj 
    237238                     DO ji = 1, jpi 
     
    256257               END DO 
    257258               ! clem: store attenuation coefficient of the first ocean level 
    258                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     259               IF ( ln_qsr_ice ) THEN 
    259260                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260261               ENDIF 
     
    279280               END DO 
    280281               ! clem: store attenuation coefficient of the first ocean level 
    281                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     282               IF ( ln_qsr_ice ) THEN 
    282283                  DO jj = 1, jpj 
    283284                     DO ji = 1, jpi 
     
    298299               END DO 
    299300               ! clem: store attenuation coefficient of the first ocean level 
    300                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     301               IF ( ln_qsr_ice ) THEN 
    301302                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    302303               ENDIF 
     
    324325            &                    'at it= ', kt,' date= ', ndastp 
    325326         IF(lwp) WRITE(numout,*) '~~~~' 
    326          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc ) 
     327         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      ) 
     328         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm  
    327329         ! 
    328330      ENDIF 
     
    379381      ! 
    380382      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init') 
    381       ! 
    382       ! Default value for fraqsr_1lev 
    383       IF( .NOT. ln_rstart ) THEN 
    384          fraqsr_1lev(:,:) = 1._wp 
    385       ENDIF 
    386383      ! 
    387384      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        )  
     
    412409         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    413410         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
    414          WRITE(numout,*) '      light penetration for ice-model LIM3     ln_qsr_ice = ', ln_qsr_ice     
    415411      ENDIF 
    416412 
     
    564560      ENDIF 
    565561      ! 
     562      ! initialisation of fraqsr_1lev used in sbcssm 
     563      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 
     564         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
     565      ELSE 
     566         fraqsr_1lev(:,:) = 1._wp   ! default definition 
     567      ENDIF 
     568      ! 
    566569      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        )  
    567570      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
Note: See TracChangeset for help on using the changeset viewer.