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 9132 for branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 – NEMO

Ignore:
Timestamp:
2017-12-19T15:42:23+01:00 (6 years ago)
Author:
andmirek
Message:

#1868 changes enabling coupling

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r6500 r9132  
    5858                uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl,   & 
    5959                swvdr,swvdf,swidr,swidf,Tf,                      & 
    60       !! When using NEMO with CICE, this change requires use of  
    61       !! one of the following two CICE branches: 
    62       !! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
    63       !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
     60!! When using NEMO with CICE, this change requires use of  
     61!! one of the following two CICE branches: 
     62!! - at CICE5.0,   hadax/r1015_GSI8_with_GSI7 
     63!! - at CICE5.1.2, hadax/vn5.1.2_GSI8 
    6464                keffn_top,Tn_top 
    6565 
    … …  
    7373   USE CICE_RunMod 
    7474   USE CICE_FinalMod 
     75   USE cpl_oasis3 
     76   USE mod_oasis 
     77   USE OASIS_NEMO_CICE 
    7578 
    7679   IMPLICIT NONE 
    … …  
    173176      REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d 
    174177      INTEGER  ::   ji, jj, jl, jk                    ! dummy loop indices 
     178      INTEGER, PARAMETER :: zkt = 1 
    175179      !!--------------------------------------------------------------------- 
    176180 
    … …  
    186190      ! Initialize CICE 
    187191      CALL CICE_Initialize 
    188  
    189192      ! Do some CICE consistency checks 
    190193      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    … …  
    202205      IF( sbc_ice_alloc()      /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 
    203206      IF( sbc_ice_cice_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 
    204  
     207#if ! defined key_nemocice_decomp 
     208     call nemo_cice_cpl_define() 
     209#endif 
    205210      ! Ensure that no temperature points are below freezing if not a NEMO restart 
    206211      IF( .NOT. ln_rstart ) THEN 
    … …  
    214219         CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d )  
    215220 
    216 #if defined key_nemocice_decomp 
    217221         ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 
    218222         ! there is no restart file. 
    219223         ! Values from a CICE restart file would overwrite this 
    220          CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
    221 #endif 
     224         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1., zkt, ssnd_n2c(id_sst0_np)%nid(1,1), srcv_n2c(id_sst_ig)%nid(1,1))  
    222225 
    223226      ENDIF   
    224227 
    225228      ! calculate surface freezing temperature and send to CICE 
    226       CALL  eos_fzp(sss_m(:,:), sstfrz(:,:), fsdept_n(:,:,1))  
    227       CALL nemo2cice(sstfrz,Tf, 'T', 1. ) 
    228  
    229       CALL cice2nemo(aice,fr_i, 'T', 1. ) 
     229      CALL eos_fzp(sss_m(:,:), sstfrz(:,:), fsdept_n(:,:,1))  
     230      CALL nemo2cice(sstfrz,Tf, 'T', 1., zkt, ssnd_n2c(id_sstfrz0_np)%nid(1,1), srcv_n2c(id_Tf0_ig)%nid(1,1) ) 
     231 
     232      CALL cice2nemo(aice,fr_i, 'T', 1., zkt, ssnd_c2n(id_aice0_ip)%nid(1,1), srcv_c2n(id_fr_i0_ng)%nid(1,1)) 
    230233      IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     234        if(lwp) write(numout,*) 'jp_flx OR jp_purecpl' 
     235        if(lwp) call flush(numout) 
    231236         DO jl=1,ncat 
    232             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     237            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1., zkt, ssnd_c2n(id_aicen0_ip)%nid(1,jl), srcv_c2n(id_a_i0_ng)%nid(1,1) ) 
    233238         ENDDO 
    234239      ENDIF 
    … …  
    250255      !                                      ! embedded sea ice 
    251256      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    252          CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    253          CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     257         if(lwp) write(numout,*) 'nn_ice_embd' 
     258         if(lwp) call flush(numout) 
     259         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1., zkt, ssnd_c2n(id_vsno0_ip)%nid(1,1), srcv_c2n(id_vsno0_ng)%nid(1,1) ) 
     260         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1., zkt, ssnd_c2n(id_vice0_ip)%nid(1,1), srcv_c2n(id_vice0_ng)%nid(1,1) ) 
    254261         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
    255262         snwice_mass_b(:,:) = snwice_mass(:,:) 
    … …  
    299306         ENDIF 
    300307      ENDIF 
    301   
     308         if(lwp) write(numout,*) 'END cice_sbc_init' 
     309         if(lwp) call flush(numout) 
    302310      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    303311      ! 
    … …  
    319327      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 
    320328      REAL(wp) ::   zintb, zintn  ! dummy argument 
     329      INTEGER :: kinfo, isec 
    321330      !!--------------------------------------------------------------------- 
    322331 
    … …  
    330339      ENDIF 
    331340 
    332       ztmp(:,:)=0.0 
    333  
    334341! Aggregate ice concentration already set in cice_sbc_out (or cice_sbc_init on  
    335342! the first time-step) 
    336343 
    337 ! forced and coupled case  
    338  
     344      ztmp(:,:)=0.0 
    339345      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    340346 
    … …  
    349355            ENDDO 
    350356         ENDDO 
    351          CALL nemo2cice(ztmp,strax,'F', -1. ) 
     357         CALL nemo2cice(ztmp,strax,'F', -1., kt, ssnd_n2c(id_strax_np)%nid(1,1), srcv_n2c(id_strax_ig)%nid(1,1) ) 
    352358 
    353359! y comp of wind stress (CI_2) 
    … …  
    359365            ENDDO 
    360366         ENDDO 
    361          CALL nemo2cice(ztmp,stray,'F', -1. ) 
     367         CALL nemo2cice(ztmp,stray,'F', -1., kt, ssnd_n2c(id_stray_np)%nid(1,1), srcv_n2c(id_stray_ig)%nid(1,1)) 
    362368 
    363369 
    … …  
    382388               ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 
    383389            ENDDO 
    384     ELSE 
     390        ELSE 
    385391           !In coupled mode - qla_ice calculated in sbc_cpl for each category 
    386392           ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) 
    … …  
    388394 
    389395         DO jl=1,ncat 
    390             CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) 
     396            CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1., kt, ssnd_n2c(id_flatn_f_np)%nid(1,jl), srcv_n2c(id_flatn_f_ig)%nid(1,jl)) 
    391397 
    392398! GBM conductive flux through ice (CI_6) 
    … …  
    397403               ztmp(:,:) = botmelt(:,:,jl) 
    398404            ENDIF 
    399             CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. ) 
     405            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1., kt, ssnd_n2c(id_fcondtopn_f_np)%nid(1,jl), srcv_n2c(id_fcondtopn_f_ig)%nid(1,jl)) 
    400406 
    401407! GBM surface heat flux (CI_7) 
    … …  
    406412               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 
    407413            ENDIF 
    408             CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ) 
     414            CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1., kt,  ssnd_n2c(id_fsurfn_f_np)%nid(1,jl), srcv_n2c(id_fsurfn_f_ig)%nid(1,jl)) 
    409415         ENDDO 
    410416 
    … …  
    414420! x comp and y comp of atmosphere surface wind (CICE expects on T points) 
    415421         ztmp(:,:) = wndi_ice(:,:) 
    416          CALL nemo2cice(ztmp,uatm,'T', -1. ) 
     422         CALL nemo2cice(ztmp,uatm,'T', -1., kt, ssnd_n2c(id_uatm_np)%nid(1,1), srcv_n2c(id_uatm_ig)%nid(1,1) ) 
    417423         ztmp(:,:) = wndj_ice(:,:) 
    418          CALL nemo2cice(ztmp,vatm,'T', -1. ) 
     424         CALL nemo2cice(ztmp,vatm,'T', -1., kt, ssnd_n2c(id_vatm_np)%nid(1,1), srcv_n2c(id_vatm_ig)%nid(1,1) ) 
    419425         ztmp(:,:) = SQRT ( wndi_ice(:,:)**2 + wndj_ice(:,:)**2 ) 
    420          CALL nemo2cice(ztmp,wind,'T', 1. )    ! Wind speed (m/s) 
     426         CALL nemo2cice(ztmp,wind,'T', 1., kt, ssnd_n2c(id_wind_np)%nid(1,1), srcv_n2c(id_wind_ig)%nid(1,1) )    ! Wind speed (m/s) 
    421427         ztmp(:,:) = qsr_ice(:,:,1) 
    422          CALL nemo2cice(ztmp,fsw,'T', 1. )     ! Incoming short-wave (W/m^2) 
     428         CALL nemo2cice(ztmp,fsw,'T', 1., kt, ssnd_n2c(id_fsw_np)%nid(1,1), srcv_n2c(id_fsw_ig)%nid(1,1) )     ! Incoming short-wave (W/m^2) 
    423429         ztmp(:,:) = qlw_ice(:,:,1) 
    424          CALL nemo2cice(ztmp,flw,'T', 1. )     ! Incoming long-wave (W/m^2) 
     430         CALL nemo2cice(ztmp,flw,'T', 1., kt, ssnd_n2c(id_flw_np)%nid(1,1), srcv_n2c(id_flw_ig)%nid(1,1) )     ! Incoming long-wave (W/m^2) 
    425431         ztmp(:,:) = tatm_ice(:,:) 
    426          CALL nemo2cice(ztmp,Tair,'T', 1. )    ! Air temperature (K) 
    427          CALL nemo2cice(ztmp,potT,'T', 1. )    ! Potential temp (K) 
     432         CALL nemo2cice(ztmp,Tair,'T', 1., kt, ssnd_n2c(id_Tair_np)%nid(1,1), srcv_n2c(id_Tair_ig)%nid(1,1) )    ! Air temperature (K) 
     433         CALL nemo2cice(ztmp,potT,'T', 1., kt, ssnd_n2c(id_potT_np)%nid(1,1), srcv_n2c(id_potT_ig)%nid(1,1) )    ! Potential temp (K) 
    428434! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows   
    429435         ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) )     
    430436                                               ! Constant (101000.) atm pressure assumed 
    431          CALL nemo2cice(ztmp,rhoa,'T', 1. )    ! Air density (kg/m^3) 
     437         CALL nemo2cice(ztmp,rhoa,'T', 1., kt, ssnd_n2c(id_rhoa_np)%nid(1,1), srcv_n2c(id_rhoa_ig)%nid(1,1) )    ! Air density (kg/m^3) 
    432438         ztmp(:,:) = qatm_ice(:,:) 
    433          CALL nemo2cice(ztmp,Qa,'T', 1. )      ! Specific humidity (kg/kg) 
     439         CALL nemo2cice(ztmp,Qa,'T', 1., kt, ssnd_n2c(id_Qa_np)%nid(1,1), srcv_n2c(id_Qa_ig)%nid(1,1) )      ! Specific humidity (kg/kg) 
    434440         ztmp(:,:)=10.0 
    435          CALL nemo2cice(ztmp,zlvl,'T', 1. )    ! Atmos level height (m) 
     441         CALL nemo2cice(ztmp,zlvl,'T', 1., kt, ssnd_n2c(id_zlvl_np)%nid(1,1), srcv_n2c(id_zlvl_ig)%nid(1,1) )    ! Atmos level height (m) 
    436442 
    437443! May want to check all values are physically realistic (as in CICE routine  
    … …  
    440446! Divide shortwave into spectral bands (as in prepare_forcing) 
    441447         ztmp(:,:)=qsr_ice(:,:,1)*frcvdr       ! visible direct 
    442          CALL nemo2cice(ztmp,swvdr,'T', 1. )              
     448         CALL nemo2cice(ztmp,swvdr,'T', 1., kt, ssnd_n2c(id_swvdr_np)%nid(1,1), srcv_n2c(id_swvdr_ig)%nid(1,1) )              
    443449         ztmp(:,:)=qsr_ice(:,:,1)*frcvdf       ! visible diffuse 
    444          CALL nemo2cice(ztmp,swvdf,'T', 1. )               
     450         CALL nemo2cice(ztmp,swvdf,'T', 1., kt, ssnd_n2c(id_swvdf_np)%nid(1,1), srcv_n2c(id_swvdf_ig)%nid(1,1) )               
    445451         ztmp(:,:)=qsr_ice(:,:,1)*frcidr       ! near IR direct 
    446          CALL nemo2cice(ztmp,swidr,'T', 1. ) 
     452         CALL nemo2cice(ztmp,swidr,'T', 1., kt, ssnd_n2c(id_swidr_np)%nid(1,1), srcv_n2c(id_swidr_ig)%nid(1,1) ) 
    447453         ztmp(:,:)=qsr_ice(:,:,1)*frcidf       ! near IR diffuse 
    448          CALL nemo2cice(ztmp,swidf,'T', 1. ) 
     454         CALL nemo2cice(ztmp,swidf,'T', 1., kt, ssnd_n2c(id_swidf_np)%nid(1,1), srcv_n2c(id_swidf_ig)%nid(1,1) ) 
    449455 
    450456      ENDIF 
    … …  
    454460      IF( iom_use('snowpre') )   CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit   
    455461      ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)   
    456       CALL nemo2cice(ztmp,fsnow,'T', 1. )  
     462      CALL nemo2cice(ztmp,fsnow,'T', 1., kt, ssnd_n2c(id_fsnow_np)%nid(1,1), srcv_n2c(id_fsnow_ig)%nid(1,1) )  
    457463 
    458464! Rainfall 
    459465      IF( iom_use('precip') )   CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 
    460466      ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    461       CALL nemo2cice(ztmp,frain,'T', 1. )  
     467      CALL nemo2cice(ztmp,frain,'T', 1., kt, ssnd_n2c(id_frain_np)%nid(1,1), srcv_n2c(id_frain_ig)%nid(1,1) )  
    462468 
    463469! Recalculate freezing temperature and send to CICE  
    464470      CALL eos_fzp(sss_m(:,:), sstfrz(:,:), fsdept_n(:,:,1))  
    465       CALL nemo2cice(sstfrz,Tf,'T', 1. ) 
     471      CALL nemo2cice(sstfrz,Tf,'T', 1., kt, ssnd_n2c(id_sstfrz_np)%nid(1,1), srcv_n2c(id_Tf_ig)%nid(1,1) ) 
    466472 
    467473! Freezing/melting potential 
    468474! Calculated over NEMO leapfrog timestep (hence 2*dt) 
    469475      nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt)  
    470       CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. ) 
     476      CALL nemo2cice(nfrzmlt,frzmlt,'T', 1., kt, ssnd_n2c(id_nfrzmlt_np)%nid(1,1), srcv_n2c(id_frzmlt_ig)%nid(1,1) ) 
    471477 
    472478! SST  and SSS 
    473479 
    474       CALL nemo2cice(sst_m,sst,'T', 1. ) 
    475       CALL nemo2cice(sss_m,sss,'T', 1. ) 
     480      CALL nemo2cice(sst_m,sst,'T', 1., kt, ssnd_n2c(id_sst_m_np)%nid(1,1), srcv_n2c(id_sst_m_ig)%nid(1,1) ) 
     481      CALL nemo2cice(sss_m,sss,'T', 1., kt, ssnd_n2c(id_sss_m_np)%nid(1,1), srcv_n2c(id_sss_m_ig)%nid(1,1) ) 
    476482 
    477483      IF( ksbc == jp_purecpl ) THEN 
    478484! Sea ice surface skin temperature 
    479485         DO jl=1,ncat 
    480            CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.) 
     486           CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1., kt, ssnd_n2c(id_tsfc_ice_np)%nid(1,jl), srcv_n2c(id_trcrn_ig)%nid(1,jl)) 
    481487         ENDDO  
    482488      ENDIF 
    … …  
    489495         ENDDO 
    490496      ENDDO 
    491       CALL nemo2cice(ztmp,uocn,'F', -1. ) 
     497      CALL nemo2cice(ztmp,uocn,'F', -1., kt, ssnd_n2c(id_uocn_np)%nid(1,1), srcv_n2c(id_uocn_ig)%nid(1,1) ) 
    492498 
    493499! V point to F point 
    … …  
    497503         ENDDO 
    498504      ENDDO 
    499       CALL nemo2cice(ztmp,vocn,'F', -1. ) 
     505      CALL nemo2cice(ztmp,vocn,'F', -1., kt, ssnd_n2c(id_vocn_np)%nid(1,1), srcv_n2c(id_vocn_ig)%nid(1,1) ) 
    500506 
    501507      IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: compute representative ice top surface ==! 
    … …  
    525531         ENDDO 
    526532      ENDDO 
    527       CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 
     533      CALL nemo2cice(ztmp,ss_tltx,'F', -1., kt, ssnd_n2c(id_ss_tltx_np)%nid(1,1), srcv_n2c(id_ss_tltx_ig)%nid(1,1) ) 
    528534 
    529535! T point to F point 
    … …  
    535541         ENDDO 
    536542      ENDDO 
    537       CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
     543      CALL nemo2cice(ztmp,ss_tlty,'F', -1., kt, ssnd_n2c(id_ss_tlty_np)%nid(1,1), srcv_n2c(id_ss_tlty_ig)%nid(1,1) ) 
    538544 
    539545      CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) 
    … …  
    555561      INTEGER  ::   ji, jj, jl                 ! dummy loop indices 
    556562      REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 
     563      INTEGER :: kinfo, isec 
     564      REAL(wp) :: amaxv, aminv 
    557565      !!--------------------------------------------------------------------- 
    558566 
    … …  
    564572         IF(lwp) WRITE(numout,*)'cice_sbc_out' 
    565573      ENDIF 
    566        
     574!     isec = (kt-1)*rdt 
     575!     ztmp1 = 2.  
     576!     CALL oasis_get ( srcv_n2c(1)%nid(1,1), isec, ztmp1(nldi:nlei, nldj:nlej), kinfo )  
     577!     amaxv = maxval(ztmp1(nldi:nlei, nldj:nlej)) 
     578!     aminv = minval(ztmp1(nldi:nlei, nldj:nlej)) 
     579!     vcice = ztmp1 
     580!     call mpp_max(amaxv) 
     581!     call mpp_min(aminv) 
     582!     if(lwp) write(numout,*) 'MAX/MIN OASIS: ', amaxv, aminv, kinfo 
     583!     write(*,*) amaxv, aminv, 'NEMO from CICE ',narea 
    567584! x comp of ocean-ice stress  
    568       CALL cice2nemo(strocnx,ztmp1,'F', -1. ) 
     585      CALL cice2nemo(strocnx,ztmp1,'F', -1., kt, ssnd_c2n(id_strocnx_ip)%nid(1,1), srcv_c2n(id_strocnx_ng)%nid(1,1)) 
    569586      ss_iou(:,:)=0.0 
    570587! F point to U point 
    … …  
    577594 
    578595! y comp of ocean-ice stress  
    579       CALL cice2nemo(strocny,ztmp1,'F', -1. ) 
     596      CALL cice2nemo(strocny,ztmp1,'F', -1., kt, ssnd_c2n(id_strocny_ip)%nid(1,1), srcv_c2n(id_strocny_ng)%nid(1,1) ) 
    580597      ss_iov(:,:)=0.0 
    581598! F point to V point 
    … …  
    598615! Also need ice/ocean stress on T points so that taum can be updated  
    599616! This interpolation is already done in CICE so best to use those values  
    600       CALL cice2nemo(strocnxT,ztmp1,'T',-1.)  
    601       CALL cice2nemo(strocnyT,ztmp2,'T',-1.)  
     617      CALL cice2nemo(strocnxT,ztmp1,'T',-1., kt, ssnd_c2n(id_strocnxT_ip)%nid(1,1), srcv_c2n(id_strocnxT_ng)%nid(1,1))  
     618      CALL cice2nemo(strocnyT,ztmp2,'T',-1., kt, ssnd_c2n(id_strocnyT_ip)%nid(1,1), srcv_c2n(id_strocnyT_ng)%nid(1,1))  
    602619  
    603620! Update taum with modulus of ice-ocean stress  
    … …  
    622639 
    623640#if defined key_cice4 
    624       CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
    625       CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     641      CALL cice2nemo(fresh_gbm,ztmp1,'T', 1., kt, ssnd_c2n(id_fresh_ai_ip)%nid(1,1), srcv_c2n(id_fresh_ai_ng)%nid(1,1)) 
     642      CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1., kt, ssnd_c2n(id_fsalt_ai_ip)%nid(1,1), srcv_c2n(id_fsalt_ai_ng)%nid(1,1) ) 
    626643#else 
    627       CALL cice2nemo(fresh_ai,ztmp1,'T', 1. ) 
    628       CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. ) 
     644      CALL cice2nemo(fresh_ai,ztmp1,'T', 1., kt, ssnd_c2n(id_fresh_ai_ip)%nid(1,1), srcv_c2n(id_fresh_ai_ng)%nid(1,1) ) 
     645      CALL cice2nemo(fsalt_ai,ztmp2,'T', 1., kt, ssnd_c2n(id_fsalt_ai_ip)%nid(1,1), srcv_c2n(id_fsalt_ai_ng)%nid(1,1) ) 
    629646#endif 
    630647 
    … …  
    661678! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
    662679#if defined key_cice4 
    663       CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     680      CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1., kt, ssnd_c2n(id_fswthru_ai_ip)%nid(1,1), srcv_c2n(id_fswthru_ai_ng)%nid(1,1) ) 
    664681#else 
    665       CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. ) 
     682      CALL cice2nemo(fswthru_ai,ztmp1,'T', 1., kt, ssnd_c2n(id_fswthru_ai_ip)%nid(1,1), srcv_c2n(id_fswthru_ai_ng)%nid(1,1) ) 
    666683#endif 
    667684      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    … …  
    675692 
    676693#if defined key_cice4 
    677       CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. ) 
     694      CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1., kt, ssnd_c2n(id_fhocn_ai_ip)%nid(1,1), srcv_c2n(id_fhocn_ai_ng)%nid(1,1) ) 
    678695#else 
    679       CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. ) 
     696      CALL cice2nemo(fhocn_ai,ztmp1,'T', 1., kt, ssnd_c2n(id_fhocn_ai_ip)%nid(1,1), srcv_c2n(id_fhocn_ai_ng)%nid(1,1) ) 
    680697#endif 
    681698      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) 
    … …  
    685702! Prepare for the following CICE time-step 
    686703 
    687       CALL cice2nemo(aice,fr_i,'T', 1. ) 
     704      CALL cice2nemo(aice,fr_i,'T', 1., kt, ssnd_c2n(id_aice_ip)%nid(1,1), srcv_c2n(id_fr_i_ng)%nid(1,1) ) 
    688705      IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    689706         DO jl=1,ncat 
    690             CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
     707            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1., kt, ssnd_c2n(id_aicen_ip)%nid(1,jl), srcv_c2n(id_a_i_ng)%nid(1,jl) ) 
    691708         ENDDO 
    692709      ENDIF 
    … …  
    706723      !                                      ! embedded sea ice 
    707724      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    708          CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 
    709          CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 
     725         CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1., kt, ssnd_c2n(id_vsno_ip)%nid(1,1), srcv_c2n(id_vsno_ng)%nid(1,1) ) 
     726         CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1., kt, ssnd_c2n(id_vice_ip)%nid(1,1), srcv_c2n(id_vice_ng)%nid(1,1) ) 
    710727         snwice_mass  (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:)  ) 
    711728         snwice_mass_b(:,:) = snwice_mass(:,:) 
    … …  
    747764! x and y comp of ice velocity 
    748765 
    749       CALL cice2nemo(uvel,u_ice,'F', -1. ) 
    750       CALL cice2nemo(vvel,v_ice,'F', -1. ) 
     766      CALL cice2nemo(uvel,u_ice,'F', -1., kt, ssnd_c2n(id_uvel_ip)%nid(1,1) , srcv_c2n(id_u_ice_ng)%nid(1,1) ) 
     767      CALL cice2nemo(vvel,v_ice,'F', -1., kt, ssnd_c2n(id_vvel_ip)%nid(1,1), srcv_c2n(id_v_ice_ng)%nid(1,1) ) 
    751768 
    752769! Ice concentration (CO_1) = a_i calculated at end of cice_sbc_out   
    … …  
    755772 
    756773      DO jl = 1,ncat 
    757          CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1. ) 
    758          CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 
     774         CALL cice2nemo(vsnon(:,:,jl,:),ht_s(:,:,jl),'T', 1., kt, ssnd_c2n(id_vsnon_ip)%nid(1,jl), srcv_c2n(id_ht_s_ng)%nid(1,jl)) 
     775         CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1., kt, ssnd_c2n(id_vicen_ip)%nid(1,jl), srcv_c2n(id_ht_i_ng)%nid(1,jl)) 
    759776      ENDDO 
    760777 
    … …  
    762779! Meltpond fraction and depth 
    763780      DO jl = 1,ncat 
    764          CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1. ) 
    765          CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1. ) 
     781         CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1., kt, ssnd_c2n(id_apeffn_ip)%nid(1,jl), srcv_c2n(id_a_p_ng)%nid(1,jl) ) 
     782         CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1., kt, ssnd_c2n(id_trcrn_ip)%nid(1,jl), srcv_c2n(id_ht_p_ng)%nid(1,jl) ) 
    766783      ENDDO 
    767784#endif 
    … …  
    776793      IF (heat_capacity) THEN 
    777794         DO jl = 1,ncat 
    778             CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1. ) 
    779             CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1. ) 
     795            CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1., kt, ssnd_c2n(id_Tn_top_ip)%nid(1,jl), srcv_c2n(id_tn_ice_ng)%nid(1,jl) ) 
     796            CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1., kt, ssnd_c2n(id_keffn_top_ip)%nid(1,jl), srcv_c2n(id_kn_ice_ng)%nid(1,jl) ) 
    780797         ENDDO 
    781798! Convert surface temperature to Kelvin 
    … …  
    926943   END SUBROUTINE cice_sbc_force 
    927944 
    928    SUBROUTINE nemo2cice( pn, pc, cd_type, psgn) 
     945   SUBROUTINE nemo2cice( pn, pc, cd_type, psgn, kt, idn, idc) 
    929946      !!--------------------------------------------------------------------- 
    930947      !!                    ***  ROUTINE nemo2cice  *** 
    … …  
    944961#endif 
    945962      !!--------------------------------------------------------------------- 
    946  
     963      INTEGER, INTENT( in ) :: idn, idc 
    947964      CHARACTER(len=1), INTENT( in ) ::   & 
    948965          cd_type       ! nature of pn grid-point 
    … …  
    952969          !             !   =-1 , the sign is modified following the type of b.c. used 
    953970          !             !   = 1 , no sign change 
     971      INTEGER, INTENT(IN) :: kt 
    954972      REAL(wp), DIMENSION(jpi,jpj) :: pn 
    955 #if !defined key_nemocice_decomp 
    956       REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 
    957       REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    958 #endif 
    959973      REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 
    960974      INTEGER (int_kind) :: & 
    … …  
    964978 
    965979      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
     980      INTEGER  ::  isec, kinfo, iblk 
     981      type (block) :: bk 
    966982 
    967983!     A. Ensure all haloes are filled in NEMO field (pn) 
    … …  
    980996 
    981997#else 
    982  
    983 !     B. Gather pn into global array (png) 
    984  
    985       IF ( jpnij > 1) THEN 
    986          CALL mppsync 
    987          CALL mppgather (pn,0,png)  
    988          CALL mppsync 
    989       ELSE 
    990          png(:,:,1)=pn(:,:) 
    991       ENDIF 
    992  
    993 !     C. Map png into CICE global array (pcg) 
    994  
    995 ! Need to make sure this is robust to changes in NEMO halo rows.... 
    996 ! (may be OK but not 100% sure) 
    997  
    998       IF (nproc==0) THEN      
    999 !        pcg(:,:)=0.0 
    1000          DO jn=1,jpnij 
    1001             DO jj=nldjt(jn),nlejt(jn) 
    1002                DO ji=nldit(jn),nleit(jn) 
    1003                   png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    1004                ENDDO 
    1005             ENDDO 
    1006          ENDDO 
    1007          DO jj=1,ny_global 
    1008             DO ji=1,nx_global 
    1009                pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 
    1010             ENDDO 
    1011          ENDDO 
    1012       ENDIF 
    1013  
     998!MA 
     999!MA!     B. Gather pn into global array (png) 
     1000!MA 
     1001!MA      IF ( jpnij > 1) THEN 
     1002!MA         CALL mppsync 
     1003!MA         CALL mppgather (pn,0,png)  
     1004!MA         CALL mppsync 
     1005!MA      ELSE 
     1006!MA         png(:,:,1)=pn(:,:) 
     1007!MA      ENDIF 
     1008 
     1009!MA!     C. Map png into CICE global array (pcg) 
     1010 
     1011!MA! Need to make sure this is robust to changes in NEMO halo rows.... 
     1012!MA! (may be OK but not 100% sure) 
     1013 
     1014!MA      IF (nproc==0) THEN      
     1015!MA!        pcg(:,:)=0.0 
     1016!MA         DO jn=1,jpnij 
     1017!MA            DO jj=nldjt(jn),nlejt(jn) 
     1018!MA               DO ji=nldit(jn),nleit(jn) 
     1019!MA                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
     1020!MA               ENDDO 
     1021!MA            ENDDO 
     1022!MA         ENDDO 
     1023!MA         DO jj=1,ny_global 
     1024!MA            DO ji=1,nx_global 
     1025!MA               pcg(ji,jj)=png2(ji+ji_off,jj+jj_off) 
     1026!MA            ENDDO 
     1027!MA         ENDDO 
     1028!MA      ENDIF 
     1029 
     1030! forced and coupled case  
     1031      isec = (kt-1)*rdt 
     1032      iblk = 1 
     1033      bk = get_block(blocks_ice(iblk), iblk) 
     1034      CALL oasis_put ( idn, isec, pn(nldi:nlei, nldj:nlej), kinfo ) 
     1035      CALL oasis_get ( idc, isec, pc(bk%ilo:bk%ihi,bk%jlo:bk%jhi,1), kinfo ) 
    10141036#endif 
    10151037 
    … …  
    10331055#else 
    10341056!     D. Scatter pcg to CICE blocks (pc) + update halos 
    1035       CALL scatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type) 
     1057!MA     CALL scatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type) 
     1058      ! Ensure CICE halos are up to date 
     1059      CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type) 
    10361060#endif 
    10371061 
    10381062   END SUBROUTINE nemo2cice 
    10391063 
    1040    SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn ) 
     1064   SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn, kt, idc, idn ) 
    10411065      !!--------------------------------------------------------------------- 
    10421066      !!                    ***  ROUTINE cice2nemo  *** 
    … …  
    10651089          !             !   = 1 , no sign change 
    10661090      REAL(wp), DIMENSION(jpi,jpj) :: pn 
    1067  
    1068 #if defined key_nemocice_decomp 
     1091      INTEGER, INTENT( in ) :: idc, idn 
     1092      INTEGER, INTENT(IN) :: kt 
     1093 
     1094!#if defined key_nemocice_decomp 
    10691095      INTEGER (int_kind) :: & 
    10701096         field_type,        & ! id for type of field (scalar, vector, angle) 
    10711097         grid_loc             ! id for location on horizontal grid 
    10721098                              ! (center, NEcorner, Nface, Eface) 
    1073 #else 
    1074       REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    1075 #endif 
     1099!#else 
     1100!MA     REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
     1101!#endif 
     1102      type(block) :: bk 
    10761103 
    10771104      REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 
    10781105 
    10791106      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
    1080  
    1081  
    1082 #if defined key_nemocice_decomp 
     1107      INTEGER :: kinfo, isec, iblk 
    10831108 
    10841109      SELECT CASE ( cd_type ) 
    … …  
    10981123      CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type) 
    10991124 
    1100  
     1125#if defined key_nemocice_decomp 
    11011126      pn(:,:)=0.0 
    11021127      DO jj=1,jpjm1 
    … …  
    11081133#else 
    11091134 
    1110 !      A. Gather CICE blocks (pc) into global array (pcg)  
    1111  
    1112       CALL gather_global(pcg, pc, 0, distrb_info) 
    1113  
    1114 !     B. Map pcg into NEMO global array (png) 
    1115  
    1116 ! Need to make sure this is robust to changes in NEMO halo rows.... 
    1117 ! (may be OK but not spent much time thinking about it) 
    1118 ! Note that non-existent pcg elements may be used below, but 
    1119 ! the lbclnk call on pn will replace these with sensible values 
    1120  
    1121       IF (nproc==0) THEN 
    1122          png(:,:,:)=0.0 
    1123          DO jn=1,jpnij 
    1124             DO jj=nldjt(jn),nlejt(jn) 
    1125                DO ji=nldit(jn),nleit(jn) 
    1126                   png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    1127                ENDDO 
    1128             ENDDO 
    1129          ENDDO 
    1130       ENDIF 
     1135!MA!      A. Gather CICE blocks (pc) into global array (pcg)  
     1136 
     1137!MA      CALL gather_global(pcg, pc, 0, distrb_info) 
     1138 
     1139!MA!     B. Map pcg into NEMO global array (png) 
     1140 
     1141!MA! Need to make sure this is robust to changes in NEMO halo rows.... 
     1142!MA! (may be OK but not spent much time thinking about it) 
     1143!MA! Note that non-existent pcg elements may be used below, but 
     1144!MA! the lbclnk call on pn will replace these with sensible values 
     1145 
     1146!MA      IF (nproc==0) THEN 
     1147!MA         png(:,:,:)=0.0 
     1148!MA         DO jn=1,jpnij 
     1149!MA            DO jj=nldjt(jn),nlejt(jn) 
     1150!MA               DO ji=nldit(jn),nleit(jn) 
     1151!MA                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
     1152!MA               ENDDO 
     1153!MA            ENDDO 
     1154!MA         ENDDO 
     1155!MA      ENDIF 
    11311156 
    11321157!     C. Scatter png into NEMO field (pn) for each processor 
    11331158 
    1134       IF ( jpnij > 1) THEN 
    1135          CALL mppsync 
    1136          CALL mppscatter (png,0,pn)  
    1137          CALL mppsync 
    1138       ELSE 
    1139          pn(:,:)=png(:,:,1) 
    1140       ENDIF 
    1141  
     1159!MA      IF ( jpnij > 1) THEN 
     1160!MA         CALL mppsync 
     1161!MA         CALL mppscatter (png,0,pn)  
     1162!MA         CALL mppsync 
     1163!MA      ELSE 
     1164!MA         pn(:,:)=png(:,:,1) 
     1165!MA      ENDIF 
     1166      isec = (kt-1)*rdt 
     1167      iblk = 1 
     1168      bk = get_block(blocks_ice(iblk), iblk) 
     1169      CALL oasis_put ( idc, isec, pc(bk%ilo:bk%ihi,bk%jlo:bk%jhi,1), kinfo ) 
     1170      CALL oasis_get ( idn, isec, pn(nldi:nlei, nldj:nlej), kinfo ) 
    11421171#endif 
    11431172 
    … …  
    11561185 
    11571186   SUBROUTINE sbc_ice_cice ( kt, ksbc )     ! Dummy routine 
     1187      INTEGER, INTENT(IN) :: kt, ksbc 
    11581188      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 
    11591189   END SUBROUTINE sbc_ice_cice 
    11601190 
    1161    SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
     1191   SUBROUTINE cice_sbc_init (kt, ksbc)    ! Dummy routine 
     1192      INTEGER, INTENT(IN) :: kt, ksbc 
    11621193      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 
    11631194   END SUBROUTINE cice_sbc_init 
Note: See TracChangeset for help on using the changeset viewer.