Ignore:
Timestamp:
2015-04-17T12:24:12+02:00 (6 years ago)
Author:
cetlod
Message:

dev_r5204_CNRS_PISCES_dcy: some improvments

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5146 r5222  
    135135 
    136136   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   albedo_oce_mix     ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     137 
     138   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: qsr_tot_tmp     ! arrays containing consecutives qsr in a day 
     139   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: qsr_ice_tmp     !  ===                        ===  
    137140 
    138141   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument 
     
    583586      ENDIF 
    584587      ! 
    585       IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) )   & 
     588      n_cpl_qsr = INT( 86400 / ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) )  ! qsr coupling frequency per day 
     589      ! 
     590      IF( ln_dm2dc .AND. n_cpl_qsr /= 1 )   & 
    586591         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 
    587592 
     593      ! 
     594      ! 
    588595      CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 
    589596      ! 
     
    10561063    
    10571064 
    1058    SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
     1065   SUBROUTINE sbc_cpl_ice_flx( p_frld  , kt, palbi   , psst    , pist    ) 
    10591066      !!---------------------------------------------------------------------- 
    10601067      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
     
    10961103      !!                   sprecip             solid precipitation over the ocean   
    10971104      !!---------------------------------------------------------------------- 
     1105      INTEGER,  INTENT(in   ), OPTIONAL         ::   kt     !  time-step 
    10981106      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    10991107      ! optional arguments, used only in 'mixed oce-ice' case 
     
    11021110      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    11031111      ! 
    1104       INTEGER ::   jl   ! dummy loop index 
     1112      INTEGER ::   it, jl   ! dummy loop index 
    11051113      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr 
    11061114      !!---------------------------------------------------------------------- 
     
    11091117      ! 
    11101118      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr ) 
     1119 
     1120      IF( PRESENT( kt ) ) it = kt 
    11111121 
    11121122      zicefr(:,:) = 1.- p_frld(:,:) 
     
    12721282            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12731283      END SELECT 
     1284      ! 
    12741285      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    12751286         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     
    12781289         ENDDO 
    12791290      ENDIF 
     1291      ! 
     1292      IF( l_trcdm2dc )  CALL sbc_cpl_qsr_mean( it )    ! computation of daily mean qsr for biogeochemical model if needed 
    12801293 
    12811294      !                                                      ! ========================= ! 
     
    13131326      ! 
    13141327   END SUBROUTINE sbc_cpl_ice_flx 
     1328 
     1329   SUBROUTINE sbc_cpl_qsr_mean( kt ) 
     1330      !!---------------------------------------------------------------------- 
     1331      !!             ***  ROUTINE sbc_cpl_mean  *** 
     1332      !! 
     1333      !! ** Purpose :   Compute daily mean qsr for biogeochmeical model in case of diurnal cycle 
     1334      !! 
     1335      !!---------------------------------------------------------------------- 
     1336      INTEGER, INTENT(in) ::   kt 
     1337      INTEGER  :: jn 
     1338 
     1339      IF( kt == nit000 ) THEN 
     1340         ALLOCATE( qsr_tot_tmp(jpi,jpj,n_cpl_qsr), qsr_ice_tmp(jpi,jpj,jpl,n_cpl_qsr) )  
     1341         DO jn = 1, n_cpl_qsr 
     1342            qsr_tot_tmp(:,:  ,jn) = qsr_tot(:,:  ) 
     1343            qsr_ice_tmp(:,:,:,jn) = qsr_ice(:,:,:) 
     1344         ENDDO 
     1345         qsr_mean    (:,:  ) = qsr_tot(:,:  )  
     1346         qsr_ice_mean(:,:,:) = qsr_ice(:,:,:) 
     1347      ENDIF 
     1348      ! 
     1349      IF( kt /= nit000 .AND.  nrcvinfo(jpr_qsroce) == OASIS_Rcv ) THEN !  => need to be done only when we receive the field 
     1350         DO jn = 1, n_cpl_qsr - 1 
     1351            qsr_tot_tmp(:,:  ,jn) = qsr_tot_tmp(:,:  ,jn+1) 
     1352            qsr_ice_tmp(:,:,:,jn) = qsr_ice_tmp(:,:,:,jn+1) 
     1353         ENDDO 
     1354         qsr_tot_tmp(:,:  ,n_cpl_qsr ) = qsr_tot(:,:  ) 
     1355         qsr_ice_tmp(:,:,:,n_cpl_qsr ) = qsr_ice(:,:,:) 
     1356         ! 
     1357         qsr_mean    (:,:) = SUM( qsr_tot_tmp(:,:,:), 3 ) / n_cpl_qsr  
     1358         qsr_ice_mean(:,:) = SUM( qsr_ice_tmp(:,:,:), 4 ) / n_cpl_qsr  
     1359         ! 
     1360      ENDIF 
     1361      ! 
     1362   END SUBROUTINE sbc_cpl_qsr_mean 
    13151363    
    13161364    
Note: See TracChangeset for help on using the changeset viewer.