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 8934 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2017-12-07T16:28:21+01:00 (6 years ago)
Author:
clem
Message:

dev_CNRS_2017: debug coupling

Location:
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r8933 r8934  
    6565   ! 
    6666   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied 
     67   ! 
     68   !                                   !!* namsbc_cpl namelist * 
     69   INTEGER , PUBLIC ::   nn_cats_cpl    !: Number of sea ice categories over which the coupling is carried out 
     70 
    6771   !!---------------------------------------------------------------------- 
    6872   !!           switch definition (improve readability) 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8933 r8934  
    116116   INTEGER, PARAMETER ::   jpr_ts_ice = 54   ! Sea ice surface temp 
    117117 
    118    INTEGER, PARAMETER ::   jprcv      = 55   ! total number of fields received   
     118   INTEGER, PARAMETER ::   jprcv      = 54   ! total number of fields received   
    119119 
    120120   INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere 
     
    159159   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent  
    160160 
    161    INTEGER :: nn_cats_cpl   ! number of sea ice categories over which the coupling is carried out 
    162  
    163161   !                                  !!** namelist namsbc_cpl ** 
    164162   TYPE ::   FLD_C                     !    
     
    171169   !                                   ! Send to the atmosphere   
    172170   TYPE(FLD_C) ::   sn_snd_temp  , sn_snd_alb , sn_snd_thick, sn_snd_crt   , sn_snd_co2,  & 
    173       &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr          
     171      &             sn_snd_thick1, sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_ttilyr 
    174172   !                                   ! Received from the atmosphere 
    175173   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr,  & 
    176174      &             sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf, sn_rcv_ts_ice 
    177    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf                               
     175   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 
    178176   ! Send to waves  
    179177   TYPE(FLD_C) ::   sn_snd_ifrac, sn_snd_crtw, sn_snd_wlev  
    180178   ! Received from waves  
    181    TYPE(FLD_C) ::   sn_rcv_hsig,sn_rcv_phioc,sn_rcv_sdrfx,sn_rcv_sdrfy,sn_rcv_wper,sn_rcv_wnum,sn_rcv_wstrf,sn_rcv_wdrag 
     179   TYPE(FLD_C) ::   sn_rcv_hsig, sn_rcv_phioc, sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper, sn_rcv_wnum, sn_rcv_wstrf, sn_rcv_wdrag 
    182180   !                                   ! Other namelist parameters 
    183181   INTEGER     ::   nn_cplmodel           ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    184182   LOGICAL     ::   ln_usecplmask         !  use a coupling mask file to merge data received from several models 
    185                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
     183                                          !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    186184   TYPE ::   DYNARR      
    187185      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3    
    188186   END TYPE DYNARR 
    189187 
    190    TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                     ! all fields recieved from the atmosphere 
     188   TYPE( DYNARR ), SAVE, DIMENSION(jprcv) ::   frcv                ! all fields recieved from the atmosphere 
    191189 
    192190   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   alb_oce_mix    ! ocean albedo sent to atmosphere (mix clear/overcast sky) 
     
    261259      ! 
    262260      CALL wrk_alloc( jpi,jpj,   zacs, zaos ) 
    263  
    264       IF( ln_meto_cpl ) THEN 
    265          tsfc_ice(:,:,:) = 0.0 
    266          a_ip    (:,:,:) = 0.0 
    267          v_ip    (:,:,:) = 0.0 
    268          t1_ice  (:,:,:) = rt0 
    269          cnd_ice (:,:,:) = 0.0 
    270          sstfrz  (:,:)   = 0.0 
    271       ENDIF 
    272261 
    273262      ! ================================ ! 
     
    459448      SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 
    460449      CASE( 'none'          )       ! nothing to do 
    461       CASE( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE.  
     450      CASE( 'oce only'      )   ;   srcv(jpr_oemp)%laction = .TRUE.  
    462451      CASE( 'conservative'  ) 
    463452         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
     
    503492      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qns%cldes' ) 
    504493      END SELECT 
    505       IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     494      IF( TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) & 
    506495         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qns%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
     496      ! 
    507497      !                                                      ! ------------------------- ! 
    508498      !                                                      !    solar radiation        !   Qsr 
     
    519509      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_qsr%cldes' ) 
    520510      END SELECT 
    521       IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. jpl > 1 ) & 
     511      IF( TRIM( sn_rcv_qsr%cldes ) == 'mixed oce-ice' .AND. nn_cats_cpl > 1 ) & 
    522512         CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qsr%cldes not currently allowed to be mixed oce-ice for multi-category ice' ) 
     513      ! 
    523514      !                                                      ! ------------------------- ! 
    524515      !                                                      !   non solar sensitivity   !   d(Qns)/d(T) 
     
    534525 
    535526      ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 
    536       IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & 
    537          CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 
     527      IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' )  & 
     528         &   CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 
     529      ! 
    538530      !                                                      ! ------------------------- ! 
    539531      !                                                      !      10m wind module      !    
     
    546538      srcv(jpr_taum)%clname = 'O_TauMod'   ;   IF( TRIM(sn_rcv_taumod%cldes) == 'coupled' )   srcv(jpr_taum)%laction = .TRUE. 
    547539      lhftau = srcv(jpr_taum)%laction 
    548  
     540      ! 
    549541      !                                                      ! ------------------------- ! 
    550542      !                                                      !      Atmospheric CO2      ! 
     
    558550         IF(lwp) WRITE(numout,*) 
    559551      ENDIF 
    560  
     552      ! 
    561553      !                                                      ! ------------------------- !  
    562554      !                                                      ! Mean Sea Level Pressure   !  
    563555      !                                                      ! ------------------------- !  
    564556      srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE.  
    565  
    566       !                                                      ! ------------------------- ! 
    567       !                                                      !   topmelt and botmelt     !    
     557      ! 
     558      !                                                      ! ------------------------- ! 
     559      !                                                      !  ice topmelt and botmelt  !    
    568560      !                                                      ! ------------------------- ! 
    569561      srcv(jpr_topm )%clname = 'OTopMlt' 
     
    571563      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
    572564         IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
    573             srcv(jpr_topm:jpr_botm)%nct = jpl 
     565            srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 
    574566         ELSE 
    575567            CALL ctl_stop( 'sbc_cpl_init: sn_rcv_iceflx%clcat should always be set to yes currently' ) 
     
    577569         srcv(jpr_topm:jpr_botm)%laction = .TRUE. 
    578570      ENDIF 
    579       !                                                      ! ----------------------------- ! 
    580  
    581       !!!!! To get NEMO4-LIM working at Met Office 
    582       srcv(jpr_ts_ice)%clname = 'OTsfIce' 
     571      !                                                      ! ------------------------- ! 
     572      !                                                      !    ice skin temperature   !    
     573      !                                                      ! ------------------------- ! 
     574      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office 
    583575      IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE. 
    584576      IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl 
    585577      IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl 
    586       !!!!! 
    587578 
    588579      !                                                      ! ------------------------- ! 
     
    629620         cpl_wdrag = .TRUE. 
    630621      ENDIF 
    631       !  
    632622      !                                                      ! ------------------------------- ! 
    633623      !                                                      !   OPA-SAS coupling - rcv by opa !    
     
    755745      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 
    756746         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    757          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = jpl 
     747         IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl 
    758748      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    759749      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
     
    780770         alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 
    781771      ENDIF 
    782  
    783772      !                                                      ! ------------------------- ! 
    784773      !                                                      !  Ice fraction & Thickness !  
     
    792781      ssnd(jps_fice1)%clname = 'OIceFrd' 
    793782      IF( k_ice /= 0 ) THEN 
    794          ssnd(jps_fice)%laction = .TRUE.                  ! if ice treated in the ocean (even in climato case) 
    795          ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used 
    796                                                           ! producing atmos-to-ice fluxes 
     783         ssnd(jps_fice)%laction  = .TRUE.                 ! if ice treated in the ocean (even in climato case) 
     784         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 
    797785! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
    798          IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct = jpl 
    799          IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 
     786         IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl 
     787         IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
    800788      ENDIF 
    801789       
     
    807795         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    808796         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    809             ssnd(jps_hice:jps_hsnw)%nct = jpl 
     797            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    810798         ENDIF 
    811799      CASE ( 'weighted ice and snow' )  
    812800         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    813          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = jpl 
     801         IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    814802      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
    815803      END SELECT 
    816804 
    817805      !                                                      ! ------------------------- !  
    818       !                                                      ! Ice Meltponds             !  
     806      !                                                      !      Ice Meltponds        !  
    819807      !                                                      ! ------------------------- !  
    820  
    821  
    822       !!!!! Getting NEMO4-LIM to work at Met Office 
    823       ssnd(jps_a_p)%clname = 'OPndFrc'     
     808      ! Needed by Met Office 
     809      ssnd(jps_a_p)%clname  = 'OPndFrc'     
    824810      ssnd(jps_ht_p)%clname = 'OPndTck'     
    825811      SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) )  
    826812      CASE ( 'none' )  
    827          ssnd(jps_a_p)%laction = .FALSE.  
     813         ssnd(jps_a_p)%laction  = .FALSE.  
    828814         ssnd(jps_ht_p)%laction = .FALSE.  
    829815      CASE ( 'ice only' )   
    830          ssnd(jps_a_p)%laction = .TRUE.  
     816         ssnd(jps_a_p)%laction  = .TRUE.  
    831817         ssnd(jps_ht_p)%laction = .TRUE.  
    832818         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    833             ssnd(jps_a_p)%nct = nn_cats_cpl  
     819            ssnd(jps_a_p)%nct  = nn_cats_cpl  
    834820            ssnd(jps_ht_p)%nct = nn_cats_cpl  
    835821         ELSE  
    836             IF ( jpl > 1 ) THEN  
     822            IF ( nn_cats_cpl > 1 ) THEN  
    837823               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )  
    838824            ENDIF  
    839825         ENDIF  
    840826      CASE ( 'weighted ice' )   
    841          ssnd(jps_a_p)%laction = .TRUE.  
     827         ssnd(jps_a_p)%laction  = .TRUE.  
    842828         ssnd(jps_ht_p)%laction = .TRUE.  
    843829         IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    844             ssnd(jps_a_p)%nct = nn_cats_cpl   
     830            ssnd(jps_a_p)%nct  = nn_cats_cpl   
    845831            ssnd(jps_ht_p)%nct = nn_cats_cpl   
    846832         ENDIF  
    847833      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes )  
    848834      END SELECT  
    849       !!!!! 
    850835  
    851836      !                                                      ! ------------------------- ! 
     
    899884      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE. 
    900885      !  
    901        
    902       !!!!! Getting NEMO4-LIM to work at the Met Office 
    903886      !                                                      ! ------------------------- !  
    904887      !                                                      ! Sea surface freezing temp !  
    905888      !                                                      ! ------------------------- !  
     889      ! needed by Met Office 
    906890      ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' )  ssnd(jps_sstfrz)%laction = .TRUE.  
    907       !!!!! 
    908  
    909891      !  
    910892      !                                                      ! ------------------------- !  
    911893      !                                                      !    Ice conductivity       !  
    912894      !                                                      ! ------------------------- !  
     895      ! needed by Met Office 
    913896      ! Note that ultimately we will move to passing an ocean effective conductivity as well so there  
    914897      ! will be some changes to the parts of the code which currently relate only to ice conductivity  
    915  
    916898      ssnd(jps_ttilyr )%clname = 'O_TtiLyr'  
    917899      SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) )  
     
    952934      END SELECT  
    953935      !  
    954         
    955936      !                                                      ! ------------------------- !  
    956937      !                                                      !     Sea surface height    !  
     
    11191100      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    11201101      REAL(wp) ::   zzx, zzy               ! temporary variables 
    1121       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     1102      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
    11221103      !!---------------------------------------------------------------------- 
    11231104      ! 
    11241105      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_rcv') 
    1125       ! 
    1126       CALL wrk_alloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
    11271106      ! 
    11281107      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    11961175      !                                                      !    wind stress module     !   (taum) 
    11971176      !                                                      ! ========================= ! 
    1198       ! 
    11991177      IF( .NOT. srcv(jpr_taum)%laction ) THEN                    ! compute wind stress module from its components if not received  
    12001178         ! => need to be done only when otx1 was changed 
     
    12231201      !                                                      !      10 m wind speed      !   (wndm) 
    12241202      !                                                      ! ========================= ! 
    1225       ! 
    12261203      IF( .NOT. srcv(jpr_w10m)%laction ) THEN                    ! compute wind spreed from wind stress module if not received   
    12271204         ! => need to be done only when taumod was changed 
     
    12591236      !                                                      ! ================== ! 
    12601237      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 
    1261       !  
    1262  
    1263       !!!!! Getting NEMO4-LIM to work at the Met Office 
    1264       !  ! Sea ice surface skin temp:  
     1238      ! 
     1239      !                                                      ! ================== ! 
     1240      !                                                      !   ice skin temp.   ! 
     1241      !                                                      ! ================== ! 
     1242#if defined key_lim3 
     1243      ! needed by Met Office 
    12651244      IF( srcv(jpr_ts_ice)%laction ) THEN  
    12661245        DO jn = 1, jpl  
     
    12781257        END DO  
    12791258      ENDIF  
    1280       !!!!! 
    1281  
    1282  
     1259#endif 
    12831260      !                                                      ! ========================= !  
    12841261      !                                                      ! Mean Sea Level Pressure   !   (taum)  
    12851262      !                                                      ! ========================= !  
    1286       !  
    12871263      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH  
    12881264          IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields  
     
    14601436         ! 
    14611437      ENDIF 
    1462       ! 
    1463       CALL wrk_dealloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
    14641438      ! 
    14651439      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_rcv') 
     
    15061480      INTEGER ::   ji, jj   ! dummy loop indices 
    15071481      INTEGER ::   itx      ! index of taux over ice 
    1508       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty  
     1482      REAL(wp), DIMENSION(jpi,jpj) ::   ztx, zty  
    15091483      !!---------------------------------------------------------------------- 
    15101484      ! 
    15111485      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_ice_tau') 
    15121486      ! 
    1513       CALL wrk_alloc( jpi,jpj,   ztx, zty ) 
    1514  
    15151487      IF( srcv(jpr_itx1)%laction ) THEN   ;   itx =  jpr_itx1    
    15161488      ELSE                                ;   itx =  jpr_otx1 
     
    16711643      ENDIF 
    16721644      !    
    1673       CALL wrk_dealloc( jpi,jpj,   ztx, zty ) 
    1674       ! 
    16751645      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_ice_tau') 
    16761646      ! 
     
    20932063         dqns_ice(:,:,:) = zdqns_ice(:,:,:) 
    20942064      ENDIF 
    2095        
     2065 
     2066#if defined key_lim3       
    20962067      IF( ln_meto_cpl ) THEN 
    20972068         !                                                      ! ========================= ! 
     
    21042075      ENDIF 
    21052076 
    2106  
    2107 #if defined key_lim3 
    21082077      !                                                      ! ========================= ! 
    21092078      !                                                      !      Transmitted Qsr      !   [W/m2] 
     
    21472116      INTEGER ::   isec, info   ! local integer 
    21482117      REAL(wp) ::   zumax, zvmax 
    2149       REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    2150       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     2118      REAL(wp), DIMENSION(jpi,jpj)     ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
     2119      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   ztmp3, ztmp4    
    21512120      !!---------------------------------------------------------------------- 
    21522121      ! 
    21532122      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_snd') 
    21542123      ! 
    2155       CALL wrk_alloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    2156       CALL wrk_alloc( jpi,jpj,jpl,   ztmp3, ztmp4 ) 
    2157  
    21582124      isec = ( kt - nit000 ) * NINT( rdt )        ! date of exchanges 
    21592125 
     
    22212187      ENDIF 
    22222188 
     2189#if defined key_lim3 
    22232190      !!!!! Getting NEMO4-LIM working at Met Office 
    22242191      ! Top layer ice temperature 
     
    22322199      ENDIF 
    22332200      !!!!! 
    2234  
     2201#endif 
    22352202 
    22362203      !                                                      ! ------------------------- ! 
     
    23472314      ENDIF 
    23482315 
     2316#if defined key_lim3 
    23492317      ! NEMO4 - Jules coupling - Met Office 
    23502318      ! Send meltpond fields   
     
    23902358      !    
    23912359      !!!!! 
    2392  
     2360#endif 
    23932361 
    23942362      !                                                      ! ------------------------- ! 
     
    27132681      IF( ssnd(jps_taum  )%laction )  CALL cpl_snd( jps_taum  , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 
    27142682 
     2683#if defined key_lim3 
    27152684      ! NEMO4 - Jules coupling - Met Office 
    27162685      CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz) 
    27172686      ztmp1(:,:) = sstfrz(:,:) + rt0 
    27182687      IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) 
    2719  
    2720       CALL wrk_dealloc( jpi,jpj,       zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 
    2721       CALL wrk_dealloc( jpi,jpj,jpl,   ztmp3, ztmp4 ) 
     2688#endif 
    27222689      ! 
    27232690      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_snd') 
Note: See TracChangeset for help on using the changeset viewer.