Changeset 2832


Ignore:
Timestamp:
2011-09-09T15:33:04+02:00 (9 years ago)
Author:
charris
Message:

#662 Latest code changes for sbccpl. These include bug-fixes, control of topmelt and botmelt coupling fields for running CICE with the UM, some more steps towards being able to run with multiple categories for LIM3 and a change in the arguments passed to sbc_cpl_ice_flx.

Location:
branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r2813 r2832  
    193193                  zclname=srcv(ji)%clname 
    194194               ENDIF 
    195                WRITE(numout,*) "Define",ji,zclname," for",PRISM_In 
     195               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 
    196196               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   & 
    197197                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror) 
  • branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2817 r2832  
    9393   INTEGER, PARAMETER ::   jpr_taum   = 30            ! wind stress module 
    9494   INTEGER, PARAMETER ::   jpr_co2    = 31 
    95    INTEGER, PARAMETER ::   jprcv      = 31            ! total number of fields received 
     95   INTEGER, PARAMETER ::   jpr_topm   = 32            ! topmeltn 
     96   INTEGER, PARAMETER ::   jpr_botm   = 33            ! botmeltn 
     97   INTEGER, PARAMETER ::   jprcv      = 33            ! total number of fields received 
    9698 
    9799   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     
    137139 
    138140#if ! defined key_lim2   &&   ! defined key_lim3 
    139    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 
    140    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice ! (jpi,jpj,jpl) 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_ice, v_ice,fr1_i0,fr2_i0, emp_ice ! jpi, jpj 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 
    141143#endif 
    142144 
     
    145147#elif ! defined key_lim2   &&   ! defined key_lim3 
    146148   INTEGER, PARAMETER ::   jpl = 1  
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice 
    147150#endif 
    148151 
     
    153156#if ! defined key_lim3 
    154157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s 
     158#endif 
     159 
     160#if ! defined key_cice 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt 
    155162#endif 
    156163 
     
    178185      ! quick patch to be able to run the coupled model without sea-ice... 
    179186      ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) ,     & 
    180                 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , STAT=ierr(2) ) 
     187                v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1),      & 
     188                emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 
    181189#endif 
    182190 
     
    216224      NAMELIST/namsbc_cpl/  sn_snd_temp, sn_snd_alb   , sn_snd_thick, sn_snd_crt   , sn_snd_co2,   & 
    217225         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,   & 
    218          &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_co2 
     226         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2 
    219227      !!--------------------------------------------------------------------- 
    220228 
     
    246254      sn_rcv_rnf    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
    247255      sn_rcv_cal    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    ) 
     256      sn_rcv_iceflx = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
    248257      sn_rcv_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    ) 
    249258 
     
    268277         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    269278         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     279         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    270280         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
    271          WRITE(numout,*)'  sent fields (mutiple ice categogies)' 
     281         WRITE(numout,*)'  sent fields (multiple ice categories)' 
    272282         WRITE(numout,*)'      surface temperature             = ', TRIM(sn_snd_temp%cldes  ), ' (', TRIM(sn_snd_temp%clcat  ), ')' 
    273283         WRITE(numout,*)'      albedo                          = ', TRIM(sn_snd_alb%cldes   ), ' (', TRIM(sn_snd_alb%clcat   ), ')' 
     
    398408      !                                                      ! ------------------------- ! 
    399409      srcv(jpr_rnf   )%clname = 'O_Runoff'   ;   IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' )   srcv(jpr_rnf)%laction = .TRUE. 
     410! This isn't right - really just want ln_rnf_emp changed 
    400411!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE. 
    401412!                                                 ELSE                                                 ;   ln_rnf = .FALSE. 
     
    416427      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    417428      END SELECT 
    418  
     429      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     430         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    419431      !                                                      ! ------------------------- ! 
    420432      !                                                      !    solar radiation        !   Qsr 
     
    430442      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    431443      END SELECT 
    432  
     444      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     445         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
    433446      !                                                      ! ------------------------- ! 
    434447      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
     
    467480      !                                                      ! ------------------------- ! 
    468481      srcv(jpr_co2 )%clname = 'O_AtmCO2'   ;   IF( TRIM(sn_rcv_co2%cldes   ) == 'coupled' )    srcv(jpr_co2 )%laction = .TRUE. 
    469  
     482      !                                                      ! ------------------------- ! 
     483      !                                                      !   topmelt and botmelt     !    
     484      !                                                      ! ------------------------- ! 
     485      srcv(jpr_topm )%clname = 'OTopMlt' 
     486      srcv(jpr_botm )%clname = 'OBotMlt' 
     487      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
     488         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
     489            srcv(jpr_topm:jpr_botm)%nct = jpl 
     490         ELSE 
     491            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 
     492         ENDIF 
     493         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
     494      ENDIF 
     495 
     496      ! Allocate all parts of frcv used for received fields 
    470497      DO jn = 1, jprcv 
    471          ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     498         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    472499      END DO 
     500      ! Allocate taum part of frcv which is used even when not received as coupling field 
     501      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 
    473502 
    474503      ! ================================ ! 
     
    533562      CASE ( 'ice and snow' )  
    534563         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    535          ssnd(jps_hice:jps_hsnw)%nct = jpl 
     564         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
     565            ssnd(jps_hice:jps_hsnw)%nct = jpl 
     566         ELSE 
     567            IF ( jpl > 1 ) THEN 
     568               CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 
     569            ENDIF 
     570         ENDIF 
    536571      CASE ( 'weighted ice and snow' )  
    537572         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
     
    756791!CDIR NOVERRCHK 
    757792               DO ji = 1, jpi  
    758                   frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_w10m)%z3(ji,jj,1) * zcoef ) 
     793                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
    759794               END DO 
    760795            END DO 
    761796         ENDIF 
     797      ELSE 
     798         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1) 
    762799      ENDIF 
    763800 
     
    10451082    
    10461083 
    1047    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1048       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1049       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1050       &                        palbi   , psst    , pist                 ) 
     1084   SUBROUTINE sbc_cpl_ice_flx( p_frld  , palbi   , psst    , pist    ) 
    10511085      !!---------------------------------------------------------------------- 
    1052       !!             ***  ROUTINE sbc_cpl_ice_flx_rcv  *** 
     1086      !!             ***  ROUTINE sbc_cpl_ice_flx  *** 
    10531087      !! 
    10541088      !! ** Purpose :   provide the heat and freshwater fluxes of the  
     
    10711105      !!             the atmosphere 
    10721106      !! 
    1073       !!             N.B. - fields over sea-ice are passed in argument so that 
    1074       !!                 the module can be compile without sea-ice. 
    10751107      !!                  - the fluxes have been separated from the stress as 
    10761108      !!                 (a) they are updated at each ice time step compare to 
     
    10831115      !! 
    10841116      !! ** Action  :   update at each nf_ice time step: 
    1085       !!                   pqns_tot, pqsr_tot  non-solar and solar total heat fluxes 
    1086       !!                   pqns_ice, pqsr_ice  non-solar and solar heat fluxes over the ice 
    1087       !!                   pemp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
    1088       !!                   pemp_ice            ice sublimation - solid precipitation over the ice 
    1089       !!                   pdqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
     1117      !!                   qns_tot, qsr_tot  non-solar and solar total heat fluxes 
     1118      !!                   qns_ice, qsr_ice  non-solar and solar heat fluxes over the ice 
     1119      !!                   emp_tot            total evaporation - precipitation(liquid and solid) (-runoff)(-calving) 
     1120      !!                   emp_ice            ice sublimation - solid precipitation over the ice 
     1121      !!                   dqns_ice           d(non-solar heat flux)/d(Temperature) over the ice 
    10901122      !!                   sprecip             solid precipitation over the ocean   
    10911123      !!---------------------------------------------------------------------- 
    10921124      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1093       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tn(:,:,1) 
    1094       USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
    1095       USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
    1096       USE wrk_nemo, ONLY:   zicefr => wrk_3d_4   ! ice fraction  
    1097       !! 
    1098       REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1099       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1100       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1101       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1102       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1103       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget        [Kg/m2/s] 
    1104       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! solid freshwater budget over ice   [Kg/m2/s] 
    1105       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! Net solid precipitation (=emp_ice) [Kg/m2/s] 
    1106       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
     1125      USE wrk_nemo, ONLY:   zcptn  => wrk_2d_2   ! rcp * tn(:,:,1) 
     1126      USE wrk_nemo, ONLY:   ztmp   => wrk_2d_3   ! temporary array 
     1127      USE wrk_nemo, ONLY:   zsnow  => wrk_2d_4   ! snow precipitation  
     1128      USE wrk_nemo, ONLY:   zicefr => wrk_2d_5   ! total ice fraction  
     1129      !! 
     1130      REAL(wp), INTENT(in   ), DIMENSION(:,:)   ::   p_frld     ! lead fraction                [0 to 1] 
    11071131      ! optional arguments, used only in 'mixed oce-ice' case 
    11081132      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo  
    11091133      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius] 
    11101134      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin] 
    1111       !! 
    1112       INTEGER ::   ji, jj           ! dummy loop indices 
    1113       INTEGER ::   isec, info       ! temporary integer 
    1114       REAL(wp)::   zcoef, ztsurf    ! temporary scalar 
     1135      ! 
     1136      INTEGER ::   jl   ! dummy loop index 
    11151137      !!---------------------------------------------------------------------- 
    11161138 
    1117       IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 4) ) THEN 
     1139      IF( wrk_in_use(2, 2,3,4,5) ) THEN 
    11181140         CALL ctl_stop('sbc_cpl_ice_flx: requested workspace arrays unavailable')   ;   RETURN 
    11191141      ENDIF 
    11201142 
    1121       zicefr(:,:,1) = 1.- p_frld(:,:,1) 
     1143      zicefr(:,:) = 1.- p_frld(:,:) 
    11221144      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,1) 
    11231145      ! 
     
    11311153      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    11321154      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 
    1133          pemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_rain)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1134          pemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1135          zsnow   (:,:) = frcv(jpr_snow)%z3(:,:,1) 
     1155         sprecip (:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here 
     1156         tprecip (:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here 
     1157         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 
     1158         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
     1159         zsnow(:,:) = frcv(jpr_snow)%z3(:,:,1) 
    11361160                           CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
    11371161         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
    1138          ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:,1) 
     1162         ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    11391163                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average) 
    11401164         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave) 
    1141       CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 
    1142          pemp_tot(:,:) = p_frld(:,:,1) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_sbpr)%z3(:,:,1) 
    1143          pemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
     1165      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
     1166         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
     1167         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 
    11441168         zsnow   (:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1) 
    11451169      END SELECT 
    1146       psprecip(:,:) = - pemp_ice(:,:) 
     1170#if ! defined key_cice 
     1171      sprecip(:,:) = - emp_ice(:,:) 
     1172#endif 
    11471173      CALL iom_put( 'snowpre'    , zsnow                               )   ! Snow 
    1148       CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:,1) )   ! Snow        over ice-free ocean  (cell average) 
    1149       CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:,1) )   ! Snow        over sea-ice         (cell average) 
    1150       CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:,1) )   ! Sublimation over sea-ice         (cell average) 
     1174      CALL iom_put( 'snow_ao_cea', zsnow(:,:         ) * p_frld(:,:) )   ! Snow        over ice-free ocean  (cell average) 
     1175      CALL iom_put( 'snow_ai_cea', zsnow(:,:         ) * zicefr(:,:) )   ! Snow        over sea-ice         (cell average) 
     1176      CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    11511177      !    
    11521178      !                                                           ! runoffs and calving (put in emp_tot) 
    11531179      IF( srcv(jpr_rnf)%laction ) THEN  
    1154          pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
     1180         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 
    11551181                           CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers 
    11561182         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers 
    11571183      ENDIF 
    11581184      IF( srcv(jpr_cal)%laction ) THEN  
    1159          pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1185         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    11601186         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) ) 
    11611187      ENDIF 
     
    11721198!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg 
    11731199!!       ENDIF      
    1174 !!       pemp_tot(:,:) = pemp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
     1200!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p  
    11751201!! 
    11761202!!gm  end of internal cooking 
    1177  
    11781203 
    11791204      !                                                      ! ========================= ! 
     
    11811206      !                                                      ! ========================= ! 
    11821207      CASE( 'oce only' )                                     ! the required field is directly provided 
    1183          pqns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
     1208         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1) 
    11841209      CASE( 'conservative' )                                      ! the required fields are directly provided 
    1185          pqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1186          pqns_ice(:,:,1) = frcv(jpr_qnsice)%z3(:,:,1) 
     1210         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1211         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1212            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
     1213         ELSE 
     1214            ! Set all category values equal for the moment 
     1215            DO jl=1,jpl 
     1216               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1217            ENDDO 
     1218         ENDIF 
    11871219      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes 
    1188          pqns_tot(:,:  ) =  p_frld(:,:,1) * frcv(jpr_qnsoce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qnsice)%z3(:,:,1) 
    1189          pqns_ice(:,:,1) =  frcv(jpr_qnsice)%z3(:,:,1) 
     1220         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
     1221         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1222            DO jl=1,jpl 
     1223               ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE  ** 
     1224               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
     1225               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl) 
     1226            ENDDO 
     1227         ELSE 
     1228            DO jl=1,jpl 
     1229               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 
     1230               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 
     1231            ENDDO 
     1232         ENDIF 
    11901233      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations 
    1191          pqns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1192          pqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
    1193             &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:,1)   & 
    1194             &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) ) 
     1234! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
     1235         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1) 
     1236         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    & 
     1237            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   & 
     1238            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) ) 
    11951239      END SELECT 
    1196       ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1197       pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean  
     1240      ztmp(:,:) = p_frld(:,:) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
     1241      qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean  
    11981242      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    11991243!!gm 
     
    12071251      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    12081252         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting  
    1209          pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
     1253         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 
    12101254         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving 
    12111255      ENDIF 
     
    12151259      !                                                      ! ========================= ! 
    12161260      CASE( 'oce only' ) 
    1217          pqsr_tot(:,:  ) = frcv(jpr_qsroce)%z3(:,:,1) 
     1261         qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1)) 
    12181262      CASE( 'conservative' ) 
    1219          pqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1220          pqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
     1263         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1264         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1265            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
     1266         ELSE 
     1267            ! Set all category values equal for the moment 
     1268            DO jl=1,jpl 
     1269               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1270            ENDDO 
     1271         ENDIF 
     1272         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1273         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 
    12211274      CASE( 'oce and ice' ) 
    1222          pqsr_tot(:,:  ) =  p_frld(:,:,1) * frcv(jpr_qsroce)%z3(:,:,1) + zicefr(:,:,1) * frcv(jpr_qsrice)%z3(:,:,1) 
    1223          pqsr_ice(:,:,1) =  frcv(jpr_qsrice)%z3(:,:,1) 
     1275         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
     1276         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1277            DO jl=1,jpl 
     1278               ! ** NEED TO MAKE SURE a_i IS PROPERLY SET AND AVAILABLE IN THIS ROUTINE ** 
     1279               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
     1280               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 
     1281            ENDDO 
     1282         ELSE 
     1283            DO jl=1,jpl 
     1284               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 
     1285               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 
     1286            ENDDO 
     1287         ENDIF 
    12241288      CASE( 'mixed oce-ice' ) 
    1225          pqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1289         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
     1290! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 
    12261291!       Create solar heat flux over ice using incoming solar heat flux and albedos 
    12271292!       ( see OASIS3 user guide, 5th edition, p39 ) 
    1228          pqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
    1229             &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:,1)   & 
    1230             &                     + palbi         (:,:,1) * zicefr(:,:,1) ) ) 
     1293         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   & 
     1294            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)   & 
     1295            &                     + palbi         (:,:,1) * zicefr(:,:) ) ) 
    12311296      END SELECT 
    12321297      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle 
    1233          pqsr_tot(:,:  ) = sbc_dcy( pqsr_tot(:,:  ) ) 
    1234          pqsr_ice(:,:,1) = sbc_dcy( pqsr_ice(:,:,1) ) 
     1298         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) ) 
     1299         DO jl=1,jpl 
     1300            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) ) 
     1301         ENDDO 
    12351302      ENDIF 
    12361303 
    12371304      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 
    12381305      CASE ('coupled') 
    1239           pdqns_ice(:,:,1) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1306         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     1307            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
     1308         ELSE 
     1309            ! Set all category values equal for the moment 
     1310            DO jl=1,jpl 
     1311               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 
     1312            ENDDO 
     1313         ENDIF 
    12401314      END SELECT 
    12411315 
    1242       IF( wrk_not_released(2, 1,2,3)  .OR.   & 
    1243           wrk_not_released(3, 4)      )   CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
     1316      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 
     1317      CASE ('coupled') 
     1318         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 
     1319         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 
     1320      END SELECT 
     1321 
     1322      IF( wrk_not_released(2, 2,3,4,5) ) CALL ctl_stop('sbc_cpl_ice_flx: failed to release workspace arrays') 
    12441323      ! 
    12451324   END SUBROUTINE sbc_cpl_ice_flx 
     
    15151594   END SUBROUTINE sbc_cpl_ice_tau 
    15161595   ! 
    1517    SUBROUTINE sbc_cpl_ice_flx( p_frld  ,                                  & 
    1518       &                        pqns_tot, pqns_ice, pqsr_tot , pqsr_ice,   & 
    1519       &                        pemp_tot, pemp_ice, pdqns_ice, psprecip,   & 
    1520       &                        palbi   , psst    , pist                ) 
     1596   SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  ) 
    15211597      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   p_frld     ! lead fraction                [0 to 1] 
    1522       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqns_tot   ! total non solar heat flux    [W/m2] 
    1523       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqns_ice   ! ice   non solar heat flux    [W/m2] 
    1524       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pqsr_tot   ! total     solar heat flux    [W/m2] 
    1525       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice   ! ice       solar heat flux    [W/m2] 
    1526       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_tot   ! total     freshwater budget  [Kg/m2/s] 
    1527       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   pemp_ice   ! ice solid freshwater budget  [Kg/m2/s] 
    1528       REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pdqns_ice  ! d(Q non solar)/d(Temperature) over ice 
    1529       REAL(wp), INTENT(  out), DIMENSION(:,:  ) ::   psprecip   ! solid precipitation          [Kg/m2/s] 
    15301598      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo 
    15311599      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius] 
    15321600      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin] 
    15331601      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)  
    1534       ! stupid definition to avoid warning message when compiling... 
    1535       pqns_tot(:,:) = 0. ; pqns_ice(:,:,:) = 0. ; pdqns_ice(:,:,:) = 0. 
    1536       pqsr_tot(:,:) = 0. ; pqsr_ice(:,:,:) = 0.  
    1537       pemp_tot(:,:) = 0. ; pemp_ice(:,:)   = 0. ; psprecip(:,:) = 0. 
    15381602   END SUBROUTINE sbc_cpl_ice_flx 
    15391603    
  • branches/2011/dev_r2802_UKMO8_sbccpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2715 r2832  
    202202#if defined key_coupled 
    203203         !                                             ! Ice surface fluxes in coupled mode  
    204          IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( reshape( frld, (/jpi,jpj,1/) ),                 & 
    205             &                                             qns_tot, qns_ice, qsr_tot , qsr_ice,   & 
    206             &                                             emp_tot, emp_ice, dqns_ice, sprecip,   & 
     204         IF( ksbc == 5 )   CALL sbc_cpl_ice_flx( frld,                                           & 
    207205            !                                optional arguments, used only in 'mixed oce-ice' case 
    208206            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist ) 
Note: See TracChangeset for help on using the changeset viewer.