Changeset 9132
- Timestamp:
- 2017-12-19T15:42:23+01:00 (7 years ago)
- Location:
- branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 10 edited
-
IOM/restart.F90 (modified) (1 diff)
-
LBC/mppini.F90 (modified) (2 diffs)
-
LBC/mppini_2.h90 (modified) (2 diffs)
-
SBC/cpl_oasis3.F90 (modified) (13 diffs)
-
SBC/sbc_oce.F90 (modified) (1 diff)
-
SBC/sbccpl.F90 (modified) (16 diffs)
-
SBC/sbcice_cice.F90 (modified) (46 diffs)
-
SBC/sbcmod.F90 (modified) (2 diffs)
-
nemogcm.F90 (modified) (2 diffs)
-
oce.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r6755 r9132 154 154 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 155 155 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 156 CALL iom_rstput( kt, nitrst, numrow, 'fromCICE' , vcice ) 156 157 #if defined key_zdfkpp 157 158 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r6498 r9132 154 154 IF( iresti == 0 ) iresti = jpni 155 155 156 #if defined key_nemocice_decomp156 !#if defined key_nemocice_decomp 157 157 ! In order to match CICE the size of domains in NEMO has to be changed 158 158 ! The last line of blocks (west) will have fewer points … … 165 165 END DO 166 166 167 #else168 169 DO jj = 1, jpnj170 DO ji = 1, iresti171 ilcit(ji,jj) = jpi172 END DO173 DO ji = iresti+1, jpni174 ilcit(ji,jj) = jpi -1175 END DO176 END DO177 178 #endif167 !#else 168 169 ! DO jj = 1, jpnj 170 ! DO ji = 1, iresti 171 ! ilcit(ji,jj) = jpi 172 ! END DO 173 ! DO ji = iresti+1, jpni 174 ! ilcit(ji,jj) = jpi -1 175 ! END DO 176 ! END DO 177 178 !#endif 179 179 nfilcit(:,:) = ilcit(:,:) 180 180 IF( irestj == 0 ) irestj = jpnj -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r6498 r9132 152 152 irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 153 153 154 #if defined key_nemocice_decomp154 !#if defined key_nemocice_decomp 155 155 ! Change padding to be consistent with CICE 156 156 ilci(1:jpni-1 ,:) = jpi … … 159 159 ilcj(:, 1:jpnj-1) = jpj 160 160 ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 161 #else162 ilci(1:iresti ,:) = jpi163 ilci(iresti+1:jpni ,:) = jpi-1164 165 ilcj(:, 1:irestj) = jpj166 ilcj(:, irestj+1:jpnj) = jpj-1167 #endif161 !#else 162 ! ilci(1:iresti ,:) = jpi 163 ! ilci(iresti+1:jpni ,:) = jpi-1 164 ! 165 ! ilcj(:, 1:irestj) = jpj 166 ! ilcj(:, irestj+1:jpnj) = jpj-1 167 !#endif 168 168 169 169 nfilcit(:,:) = ilci(:,:) -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r6486 r9132 41 41 PUBLIC cpl_freq 42 42 PUBLIC cpl_finalize 43 INTEGER, PUBLIC :: paral(5) ! OASIS3 box partition 43 44 44 45 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 71 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 72 73 LOGICAL :: laction ! To be coupled or not 73 CHARACTER(len = 8 ):: clname ! Name of the coupling field74 CHARACTER(len = 80) :: clname ! Name of the coupling field 74 75 CHARACTER(len = 1) :: clgrid ! Grid type 75 76 REAL(wp) :: nsgn ! Control of the sign change … … 80 81 81 82 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields 83 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv_c2n, ssnd_n2c 82 84 83 85 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving … … 137 139 ! 138 140 INTEGER :: id_part 139 141 ! INTEGER :: paral(5) ! OASIS3 box partition 140 142 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 141 143 INTEGER :: ji,jc,jm ! local loop indicees … … 145 147 146 148 IF(lwp) WRITE(numout,*) 147 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmospherecase'149 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled case' 148 150 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 149 151 IF(lwp) WRITE(numout,*) … … 188 190 paral(4) = nlej-nldj+1 ! local extent in j 189 191 paral(5) = jpiglo ! global extent in x 190 191 192 IF( ln_ctl ) THEN 192 193 WRITE(numout,*) ' multiexchg: paral (1:5)', paral … … 196 197 ENDIF 197 198 198 CALL oasis_def_partition ( id_part, paral, nerror )199 CALL oasis_def_partition ( id_part, paral, nerror, name="oce" ) 199 200 ! 200 201 ! ... Announce send variables. 201 202 ! 202 ssnd(:)%ncplmodel = kcplmodel203 ssnd(:)%ncplmodel = 1 203 204 ! 204 205 DO ji = 1, ksnd … … 238 239 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 239 240 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 241 END DO 242 END DO 243 ENDIF 244 245 IF ( ssnd_n2c(ji)%laction ) THEN 246 IF( ssnd_n2c(ji)%nct > nmaxcat ) THEN 247 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 248 & TRIM(ssnd_n2c(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 249 RETURN 250 ENDIF 251 DO jc = 1, ssnd_n2c(ji)%nct 252 DO jm = 1, kcplmodel 253 254 IF ( ssnd_n2c(ji)%nct .GT. 1 ) THEN 255 WRITE(cli2,'(i2.2)') jc 256 zclname = TRIM(ssnd_n2c(ji)%clname)//'_cat'//cli2 257 ELSE 258 zclname = ssnd_n2c(ji)%clname 259 ENDIF 260 IF ( kcplmodel > 1 ) THEN 261 WRITE(cli2,'(i2.2)') jm 262 zclname = 'model'//cli2//'_'//TRIM(zclname) 263 ENDIF 264 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 265 CALL oasis_def_var (ssnd_n2c(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 266 & OASIS_Out , ishape , OASIS_REAL, nerror ) 267 IF ( nerror /= OASIS_Ok ) THEN 268 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 269 CALL oasis_abort ( ssnd_n2c(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 270 ENDIF 271 IF( ln_ctl .AND. ssnd_n2c(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 272 IF( ln_ctl .AND. ssnd_n2c(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 240 273 END DO 241 274 END DO … … 287 320 END DO 288 321 ENDIF 322 323 IF ( srcv_c2n(ji)%laction ) THEN 324 325 IF( srcv_c2n(ji)%nct > nmaxcat ) THEN 326 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 327 & TRIM(srcv_c2n(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 328 RETURN 329 ENDIF 330 331 DO jc = 1, srcv_c2n(ji)%nct 332 DO jm = 1, kcplmodel 333 334 IF ( srcv_c2n(ji)%nct .GT. 1 ) THEN 335 WRITE(cli2,'(i2.2)') jc 336 zclname = TRIM(srcv_c2n(ji)%clname)//'_cat'//cli2 337 ELSE 338 zclname = srcv_c2n(ji)%clname 339 ENDIF 340 IF ( kcplmodel > 1 ) THEN 341 WRITE(cli2,'(i2.2)') jm 342 zclname = 'model'//cli2//'_'//TRIM(zclname) 343 ENDIF 344 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 345 CALL oasis_def_var (srcv_c2n(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 346 & OASIS_In , ishape , OASIS_REAL, nerror ) 347 IF ( nerror /= OASIS_Ok ) THEN 348 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 349 CALL oasis_abort ( srcv_c2n(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 350 ENDIF 351 IF( ln_ctl .AND. srcv_c2n(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 352 IF( ln_ctl .AND. srcv_c2n(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 353 END DO 354 END DO 355 ENDIF 289 356 END DO 290 357 … … 293 360 !------------------------------------------------------------------ 294 361 295 296 362 ! CALL oasis_enddef(nerror) 363 ! IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 297 364 ! 298 365 END SUBROUTINE cpl_define … … 430 497 INTEGER :: ji,jm ! local loop index 431 498 INTEGER :: mop 499 INTEGER :: ncpl 432 500 !!---------------------------------------------------------------------- 433 501 cpl_freq = 0 ! defaut definition 434 502 id = -1 ! defaut definition 503 ncpl = 1 435 504 ! 436 505 DO ji = 1, nsnd … … 459 528 ENDDO 460 529 ! 530 531 DO ji = 1, nsnd 532 IF (ssnd_n2c(ji)%laction ) THEN 533 DO jm = 1, 1 534 IF( ssnd_n2c(ji)%nid(1,jm) /= -1 ) THEN 535 IF( TRIM(cdfieldname) == TRIM(ssnd_n2c(ji)%clname) ) THEN 536 id = ssnd_n2c(ji)%nid(1,1) 537 mop = OASIS_Out 538 ncpl = 1 539 ENDIF 540 ENDIF 541 ENDDO 542 ENDIF 543 ENDDO 461 544 IF( id /= -1 ) THEN 462 545 #if defined key_oa3mct_v3 463 CALL oasis_get_freqs(id, mop, 1, itmp, info)546 CALL oasis_get_freqs(id, mop, ncpl, itmp, info) 464 547 #else 465 CALL oasis_get_freqs(id, 1, itmp, info)548 CALL oasis_get_freqs(id, ncpl, itmp, info) 466 549 #endif 467 550 cpl_freq = itmp(1) … … 514 597 END SUBROUTINE oasis_get_localcomm 515 598 516 SUBROUTINE oasis_def_partition(k1,k2,k3 )599 SUBROUTINE oasis_def_partition(k1,k2,k3, name) 517 600 INTEGER , INTENT( out) :: k1,k3 518 601 INTEGER , INTENT(in ) :: k2(5) 602 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name 519 603 k1 = k2(1) ; k3 = k2(5) 520 604 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r6488 r9132 35 35 LOGICAL , PUBLIC :: ln_blk_core !: CORE bulk formulation 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 #if defined key_oasis3 37 #if defined key_oasis3 || ! defined key_nemocice_decomp 38 38 LOGICAL , PUBLIC :: lk_oasis = .TRUE. !: OASIS used 39 39 #else -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6912 r9132 52 52 #endif 53 53 USE lib_fortran, ONLY: glob_sum 54 #if ! defined key_nemocice_decomp 55 USE OASIS_NEMO_CICE 56 #endif 57 54 58 55 59 IMPLICIT NONE … … 149 153 INTEGER, PARAMETER :: jpsnd = 35 ! total number of fields sent 150 154 155 !NEMO CICE coupling intervace 156 !NEMO send: 157 INTEGER, PARAMETER, PUBLIC :: id_sst0_np = 1 158 INTEGER, PARAMETER, PUBLIC :: id_sstfrz0_np = 2 159 INTEGER, PARAMETER, PUBLIC :: id_strax_np = 3 160 INTEGER, PARAMETER, PUBLIC :: id_stray_np = 4 161 INTEGER, PARAMETER, PUBLIC :: id_flatn_f_np = 5 162 INTEGER, PARAMETER, PUBLIC :: id_fcondtopn_f_np = 6 163 INTEGER, PARAMETER, PUBLIC :: id_fsurfn_f_np = 7 164 INTEGER, PARAMETER, PUBLIC :: id_uatm_np = 8 165 INTEGER, PARAMETER, PUBLIC :: id_vatm_np = 9 166 INTEGER, PARAMETER, PUBLIC :: id_wind_np = 10 167 INTEGER, PARAMETER, PUBLIC :: id_fsw_np = 11 168 INTEGER, PARAMETER, PUBLIC :: id_flw_np = 12 169 INTEGER, PARAMETER, PUBLIC :: id_Tair_np = 13 170 INTEGER, PARAMETER, PUBLIC :: id_potT_np = 14 171 INTEGER, PARAMETER, PUBLIC :: id_rhoa_np = 15 172 INTEGER, PARAMETER, PUBLIC :: id_Qa_np = 16 173 INTEGER, PARAMETER, PUBLIC :: id_zlvl_np = 17 174 INTEGER, PARAMETER, PUBLIC :: id_swvdr_np = 18 175 INTEGER, PARAMETER, PUBLIC :: id_swvdf_np = 19 176 INTEGER, PARAMETER, PUBLIC :: id_swidr_np = 20 177 INTEGER, PARAMETER, PUBLIC :: id_swidf_np = 21 178 INTEGER, PARAMETER, PUBLIC :: id_fsnow_np = 22 179 INTEGER, PARAMETER, PUBLIC :: id_frain_np = 23 180 INTEGER, PARAMETER, PUBLIC :: id_sstfrz_np = 24 181 INTEGER, PARAMETER, PUBLIC :: id_nfrzmlt_np = 25 182 INTEGER, PARAMETER, PUBLIC :: id_sst_m_np = 26 183 INTEGER, PARAMETER, PUBLIC :: id_sss_m_np = 27 184 INTEGER, PARAMETER, PUBLIC :: id_tsfc_ice_np = 28 185 INTEGER, PARAMETER, PUBLIC :: id_uocn_np = 29 186 INTEGER, PARAMETER, PUBLIC :: id_vocn_np = 30 187 INTEGER, PARAMETER, PUBLIC :: id_ss_tltx_np = 31 188 INTEGER, PARAMETER, PUBLIC :: id_ss_tlty_np = 32 189 !NEMO get: 190 INTEGER, PARAMETER, PUBLIC :: id_fr_i0_ng = 1 191 INTEGER, PARAMETER, PUBLIC :: id_a_i0_ng = 2 192 INTEGER, PARAMETER, PUBLIC :: id_vsno0_ng = 3 193 INTEGER, PARAMETER, PUBLIC :: id_vice0_ng = 4 194 INTEGER, PARAMETER, PUBLIC :: id_strocnx_ng = 5 195 INTEGER, PARAMETER, PUBLIC :: id_strocny_ng = 6 196 INTEGER, PARAMETER, PUBLIC :: id_strocnxT_ng = 7 197 INTEGER, PARAMETER, PUBLIC :: id_strocnyT_ng = 8 198 INTEGER, PARAMETER, PUBLIC :: id_fresh_ai_ng = 9 199 INTEGER, PARAMETER, PUBLIC :: id_fsalt_ai_ng = 10 200 INTEGER, PARAMETER, PUBLIC :: id_fswthru_ai_ng = 11 201 INTEGER, PARAMETER, PUBLIC :: id_fhocn_ai_ng = 12 202 INTEGER, PARAMETER, PUBLIC :: id_fr_i_ng = 13 203 INTEGER, PARAMETER, PUBLIC :: id_a_i_ng = 14 204 INTEGER, PARAMETER, PUBLIC :: id_vsno_ng = 15 205 INTEGER, PARAMETER, PUBLIC :: id_vice_ng = 16 206 INTEGER, PARAMETER, PUBLIC :: id_a_p_ng = 17 207 INTEGER, PARAMETER, PUBLIC :: id_ht_p_ng = 18 208 !hadgem 209 INTEGER, PARAMETER, PUBLIC :: id_u_ice_ng = 19 210 INTEGER, PARAMETER, PUBLIC :: id_v_ice_ng = 20 211 INTEGER, PARAMETER, PUBLIC :: id_ht_s_ng = 21 212 INTEGER, PARAMETER, PUBLIC :: id_ht_i_ng = 22 213 INTEGER, PARAMETER, PUBLIC :: id_tn_ice_ng = 23 214 INTEGER, PARAMETER, PUBLIC :: id_kn_ice_ng = 24 215 151 216 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 152 ! i.e. specifically nmol/L (= umol/m3) 217 153 218 154 219 ! !!** namelist namsbc_cpl ** … … 173 238 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 174 239 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 240 LOGICAL, PARAMETER :: LOASIS_NEMO_CICE = .TRUE. 175 241 TYPE :: DYNARR 176 242 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 273 339 WRITE(numout,*)'~~~~~~~~~~~~' 274 340 ENDIF 275 IF( lwp .AND. ln_cpl ) THEN ! control print 341 ! IF( lwp .AND. ln_cpl ) THEN ! control print 342 IF( lwp ) THEN 276 343 WRITE(numout,*)' received fields (mutiple ice categories)' 277 344 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 533 600 srcv(jpr_atm_dust)%laction = .TRUE. 534 601 END IF 535 602 536 603 ! ! ------------------------- ! 537 604 ! ! topmelt and botmelt ! … … 643 710 ENDIF 644 711 ENDIF 645 712 713 srcv(:)%laction = .FALSE. 714 646 715 ! =================================================== ! 647 716 ! Allocate all parts of frcv used for received fields ! … … 663 732 END IF 664 733 734 ! =================================================== ! 735 ! NEMO CICE interface recv definitions ! 736 ! =================================================== ! 737 srcv_c2n(:)%laction = .FALSE. 738 ! 739 ! srcv_c2n(1)%laction = .TRUE. 740 ! srcv_c2n(1)%clgrid = 'T' 741 ! srcv_c2n(1)%nsgn = 1. 742 ! srcv_c2n(1)%clname = 'OCN_O1G' 743 ! srcv_c2n(1)%nct = 1 744 ! srcv_c2n(1)%ncplmodel = 1 745 #if ! defined key_nemocice_decomp 746 !initialization 747 srcv_c2n(id_fr_i0_ng)%laction = .TRUE. 748 srcv_c2n(id_fr_i0_ng)%clgrid = 'T' 749 srcv_c2n(id_fr_i0_ng)%nsgn = 1. 750 srcv_c2n(id_fr_i0_ng)%clname = 'fr_i0_ng' 751 srcv_c2n(id_fr_i0_ng)%nct = 1 752 srcv_c2n(id_fr_i0_ng)%ncplmodel = 1 753 754 srcv_c2n(id_a_i0_ng)%laction = .FALSE. 755 srcv_c2n(id_a_i0_ng)%clgrid = 'T' 756 srcv_c2n(id_a_i0_ng)%nsgn = 1. 757 srcv_c2n(id_a_i0_ng)%clname = 'a_i0_ng' 758 srcv_c2n(id_a_i0_ng)%nct = 5 759 srcv_c2n(id_a_i0_ng)%ncplmodel = 1 760 761 srcv_c2n(id_vsno0_ng)%laction = .TRUE. 762 srcv_c2n(id_vsno0_ng)%clgrid = 'T' 763 srcv_c2n(id_vsno0_ng)%nsgn = 1. 764 srcv_c2n(id_vsno0_ng)%clname = 'vsno0_ng' 765 srcv_c2n(id_vsno0_ng)%nct = 1 766 srcv_c2n(id_vsno0_ng)%ncplmodel = 1 767 768 srcv_c2n(id_vice0_ng)%laction = .TRUE. 769 srcv_c2n(id_vice0_ng)%clgrid = 'T' 770 srcv_c2n(id_vice0_ng)%nsgn = 1. 771 srcv_c2n(id_vice0_ng)%clname = 'vice0_ng' 772 srcv_c2n(id_vice0_ng)%nct = 1 773 srcv_c2n(id_vice0_ng)%ncplmodel = 1 774 !time stepping 775 srcv_c2n(id_strocnx_ng)%laction = .TRUE. 776 srcv_c2n(id_strocnx_ng)%clgrid = 'F' 777 srcv_c2n(id_strocnx_ng)%nsgn = 1. 778 srcv_c2n(id_strocnx_ng)%clname = 'strocnx_ng' 779 srcv_c2n(id_strocnx_ng)%nct = 1 780 srcv_c2n(id_strocnx_ng)%ncplmodel = 1 781 782 srcv_c2n(id_strocny_ng)%laction = .TRUE. 783 srcv_c2n(id_strocny_ng)%clgrid = 'F' 784 srcv_c2n(id_strocny_ng)%nsgn = 1. 785 srcv_c2n(id_strocny_ng)%clname = 'strocny_ng' 786 srcv_c2n(id_strocny_ng)%nct = 1 787 srcv_c2n(id_strocny_ng)%ncplmodel = 1 788 789 srcv_c2n(id_strocnxT_ng)%laction = .TRUE. 790 srcv_c2n(id_strocnxT_ng)%clgrid = 'T' 791 srcv_c2n(id_strocnxT_ng)%nsgn = 1. 792 srcv_c2n(id_strocnxT_ng)%clname = 'strocnxT_ng' 793 srcv_c2n(id_strocnxT_ng)%nct = 1 794 srcv_c2n(id_strocnxT_ng)%ncplmodel = 1 795 796 srcv_c2n(id_strocnyT_ng)%laction = .TRUE. 797 srcv_c2n(id_strocnyT_ng)%clgrid = 'T' 798 srcv_c2n(id_strocnyT_ng)%nsgn = 1. 799 srcv_c2n(id_strocnyT_ng)%clname = 'strocnyT_ng' 800 srcv_c2n(id_strocnyT_ng)%nct = 1 801 srcv_c2n(id_strocnyT_ng)%ncplmodel = 1 802 803 srcv_c2n(id_fresh_ai_ng)%laction = .TRUE. 804 srcv_c2n(id_fresh_ai_ng)%clgrid = 'T' 805 srcv_c2n(id_fresh_ai_ng)%nsgn = 1. 806 srcv_c2n(id_fresh_ai_ng)%clname = 'fresh_ai_ng' 807 srcv_c2n(id_fresh_ai_ng)%nct = 1 808 srcv_c2n(id_fresh_ai_ng)%ncplmodel = 1 809 810 srcv_c2n(id_fsalt_ai_ng)%laction = .TRUE. 811 srcv_c2n(id_fsalt_ai_ng)%clgrid = 'T' 812 srcv_c2n(id_fsalt_ai_ng)%nsgn = 1. 813 srcv_c2n(id_fsalt_ai_ng)%clname = 'fsalt_ai_ng' 814 srcv_c2n(id_fsalt_ai_ng)%nct = 1 815 srcv_c2n(id_fsalt_ai_ng)%ncplmodel = 1 816 817 srcv_c2n(id_fswthru_ai_ng)%laction = .TRUE. 818 srcv_c2n(id_fswthru_ai_ng)%clgrid = 'T' 819 srcv_c2n(id_fswthru_ai_ng)%nsgn = 1. 820 srcv_c2n(id_fswthru_ai_ng)%clname = 'fswthru_ai_ng' 821 srcv_c2n(id_fswthru_ai_ng)%nct = 1 822 srcv_c2n(id_fswthru_ai_ng)%ncplmodel = 1 823 824 srcv_c2n(id_fhocn_ai_ng)%laction = .TRUE. 825 srcv_c2n(id_fhocn_ai_ng)%clgrid = 'T' 826 srcv_c2n(id_fhocn_ai_ng)%nsgn = 1. 827 srcv_c2n(id_fhocn_ai_ng)%clname = 'fhocn_ai_ng' 828 srcv_c2n(id_fhocn_ai_ng)%nct = 1 829 srcv_c2n(id_fhocn_ai_ng)%ncplmodel = 1 830 831 srcv_c2n(id_fr_i_ng)%laction = .TRUE. 832 srcv_c2n(id_fr_i_ng)%clgrid = 'T' 833 srcv_c2n(id_fr_i_ng)%nsgn = 1. 834 srcv_c2n(id_fr_i_ng)%clname = 'fr_i_ng' 835 srcv_c2n(id_fr_i_ng)%nct = 1 836 srcv_c2n(id_fr_i_ng)%ncplmodel = 1 837 838 srcv_c2n(id_a_i_ng)%laction = .TRUE. 839 srcv_c2n(id_a_i_ng)%clgrid = 'F' 840 srcv_c2n(id_a_i_ng)%nsgn = 1. 841 srcv_c2n(id_a_i_ng)%clname = 'a_i_ng' 842 srcv_c2n(id_a_i_ng)%nct = 5 843 srcv_c2n(id_a_i_ng)%ncplmodel = 1 844 845 srcv_c2n(id_vsno_ng)%laction = .TRUE. 846 srcv_c2n(id_vsno_ng)%clgrid = 'F' 847 srcv_c2n(id_vsno_ng)%nsgn = 1. 848 srcv_c2n(id_vsno_ng)%clname = 'vsno_ng' 849 srcv_c2n(id_vsno_ng)%nct = 1 850 srcv_c2n(id_vsno_ng)%ncplmodel = 1 851 852 srcv_c2n(id_vice_ng)%laction = .TRUE. 853 srcv_c2n(id_vice_ng)%clgrid = 'F' 854 srcv_c2n(id_vice_ng)%nsgn = 1. 855 srcv_c2n(id_vice_ng)%clname = 'vice_ng' 856 srcv_c2n(id_vice_ng)%nct = 1 857 srcv_c2n(id_vice_ng)%ncplmodel = 1 858 #endif 665 859 ! ================================ ! 666 860 ! Define the send interface ! … … 722 916 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 723 917 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 724 918 ! in producing atmos-to-ice fluxes 725 919 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 726 920 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl … … 924 1118 ENDIF 925 1119 ENDIF 926 927 ! 1120 1121 ssnd(:)%laction = .FALSE. 1122 ! NEMO cice send interface 1123 ssnd_n2c(:)%laction = .FALSE. 1124 ! ssnd_n2c(1)%laction = .TRUE. 1125 ! ssnd_n2c(1)%clgrid = 'T' 1126 ! ssnd_n2c(1)%nsgn = 1. 1127 ! ssnd_n2c(1)%clname = 'OCN_O1P' 1128 ! ssnd_n2c(1)%nct = 1 1129 ! ssnd_n2c(1)%ncplmodel = 1 1130 #if ! defined key_nemocice_decomp 1131 ssnd_n2c(id_sst0_np)%laction = .TRUE. 1132 ssnd_n2c(id_sst0_np)%clgrid = 'T' 1133 ssnd_n2c(id_sst0_np)%nsgn = 1. 1134 ssnd_n2c(id_sst0_np)%clname = 'sst_np' 1135 ssnd_n2c(id_sst0_np)%nct = 1 1136 ssnd_n2c(id_sst0_np)%ncplmodel = 1 1137 1138 ssnd_n2c(id_sstfrz0_np)%laction = .TRUE. 1139 ssnd_n2c(id_sstfrz0_np)%clgrid = 'T' 1140 ssnd_n2c(id_sstfrz0_np)%nsgn = 1. 1141 ssnd_n2c(id_sstfrz0_np)%clname = 'sstfrz0_np' 1142 ssnd_n2c(id_sstfrz0_np)%nct = 1 1143 ssnd_n2c(id_sstfrz0_np)%ncplmodel = 1 1144 1145 ssnd_n2c(id_strax_np)%laction = .TRUE. 1146 ssnd_n2c(id_strax_np)%clgrid = 'T' 1147 ssnd_n2c(id_strax_np)%nsgn = 1. 1148 ssnd_n2c(id_strax_np)%clname = 'strax_np' 1149 ssnd_n2c(id_strax_np)%nct = 1 1150 ssnd_n2c(id_strax_np)%ncplmodel = 1 1151 1152 ssnd_n2c(id_stray_np)%laction = .TRUE. 1153 ssnd_n2c(id_stray_np)%clgrid = 'T' 1154 ssnd_n2c(id_stray_np)%nsgn = 1. 1155 ssnd_n2c(id_stray_np)%clname = 'stray_np' 1156 ssnd_n2c(id_stray_np)%nct = 1 1157 ssnd_n2c(id_stray_np)%ncplmodel = 1 1158 1159 ssnd_n2c(id_flatn_f_np)%laction = .TRUE. 1160 ssnd_n2c(id_flatn_f_np)%clgrid = 'T' 1161 ssnd_n2c(id_flatn_f_np)%nsgn = 1. 1162 ssnd_n2c(id_flatn_f_np)%clname = 'flatn_f_np' 1163 ssnd_n2c(id_flatn_f_np)%nct = 5 1164 ssnd_n2c(id_flatn_f_np)%ncplmodel = 1 1165 1166 ssnd_n2c(id_fcondtopn_f_np)%laction = .FALSE. 1167 ssnd_n2c(id_fcondtopn_f_np)%clgrid = 'T' 1168 ssnd_n2c(id_fcondtopn_f_np)%nsgn = 1. 1169 ssnd_n2c(id_fcondtopn_f_np)%clname = 'fcondtopn_f_np' 1170 ssnd_n2c(id_fcondtopn_f_np)%nct = 5 1171 ssnd_n2c(id_fcondtopn_f_np)%ncplmodel = 1 1172 1173 ssnd_n2c(id_fsurfn_f_np)%laction = .TRUE. 1174 ssnd_n2c(id_fsurfn_f_np)%clgrid = 'T' 1175 ssnd_n2c(id_fsurfn_f_np)%nsgn = 1. 1176 ssnd_n2c(id_fsurfn_f_np)%clname = 'fsurfn_f_np' 1177 ssnd_n2c(id_fsurfn_f_np)%nct = 5 1178 ssnd_n2c(id_fsurfn_f_np)%ncplmodel = 1 1179 1180 ssnd_n2c(id_uatm_np)%laction = .TRUE. 1181 ssnd_n2c(id_uatm_np)%clgrid = 'T' 1182 ssnd_n2c(id_uatm_np)%nsgn = 1. 1183 ssnd_n2c(id_uatm_np)%clname = 'uatm_np' 1184 ssnd_n2c(id_uatm_np)%nct = 1 1185 ssnd_n2c(id_uatm_np)%ncplmodel = 1 1186 1187 ssnd_n2c(id_vatm_np)%laction = .TRUE. 1188 ssnd_n2c(id_vatm_np)%clgrid = 'T' 1189 ssnd_n2c(id_vatm_np)%nsgn = 1. 1190 ssnd_n2c(id_vatm_np)%clname = 'vatm_np' 1191 ssnd_n2c(id_vatm_np)%nct = 1 1192 ssnd_n2c(id_vatm_np)%ncplmodel = 1 1193 1194 ssnd_n2c(id_wind_np)%laction = .TRUE. 1195 ssnd_n2c(id_wind_np)%clgrid = 'T' 1196 ssnd_n2c(id_wind_np)%nsgn = 1. 1197 ssnd_n2c(id_wind_np)%clname = 'wind_np' 1198 ssnd_n2c(id_wind_np)%nct = 1 1199 ssnd_n2c(id_wind_np)%ncplmodel = 1 1200 1201 ssnd_n2c(id_fsw_np)%laction = .TRUE. 1202 ssnd_n2c(id_fsw_np)%clgrid = 'T' 1203 ssnd_n2c(id_fsw_np)%nsgn = 1. 1204 ssnd_n2c(id_fsw_np)%clname = 'fsw_np' 1205 ssnd_n2c(id_fsw_np)%nct = 1 1206 ssnd_n2c(id_fsw_np)%ncplmodel = 1 1207 1208 ssnd_n2c(id_flw_np)%laction = .TRUE. 1209 ssnd_n2c(id_flw_np)%clgrid = 'T' 1210 ssnd_n2c(id_flw_np)%nsgn = 1. 1211 ssnd_n2c(id_flw_np)%clname = 'flw_np' 1212 ssnd_n2c(id_flw_np)%nct = 1 1213 ssnd_n2c(id_flw_np)%ncplmodel = 1 1214 1215 ssnd_n2c(id_Tair_np)%laction = .TRUE. 1216 ssnd_n2c(id_Tair_np)%clgrid = 'T' 1217 ssnd_n2c(id_Tair_np)%nsgn = 1. 1218 ssnd_n2c(id_Tair_np)%clname = 'Tair_np' 1219 ssnd_n2c(id_Tair_np)%nct = 1 1220 ssnd_n2c(id_Tair_np)%ncplmodel = 1 1221 1222 ssnd_n2c(id_potT_np)%laction = .TRUE. 1223 ssnd_n2c(id_potT_np)%clgrid = 'T' 1224 ssnd_n2c(id_potT_np)%nsgn = 1. 1225 ssnd_n2c(id_potT_np)%clname = 'potT_np' 1226 ssnd_n2c(id_potT_np)%nct = 1 1227 ssnd_n2c(id_potT_np)%ncplmodel = 1 1228 1229 ssnd_n2c(id_rhoa_np)%laction = .TRUE. 1230 ssnd_n2c(id_rhoa_np)%clgrid = 'T' 1231 ssnd_n2c(id_rhoa_np)%nsgn = 1. 1232 ssnd_n2c(id_rhoa_np)%clname = 'rhoa_np' 1233 ssnd_n2c(id_rhoa_np)%nct = 1 1234 ssnd_n2c(id_rhoa_np)%ncplmodel = 1 1235 1236 ssnd_n2c(id_Qa_np)%laction = .TRUE. 1237 ssnd_n2c(id_Qa_np)%clgrid = 'T' 1238 ssnd_n2c(id_Qa_np)%nsgn = 1. 1239 ssnd_n2c(id_Qa_np)%clname = 'Qa_np' 1240 ssnd_n2c(id_Qa_np)%nct = 1 1241 ssnd_n2c(id_Qa_np)%ncplmodel = 1 1242 1243 ssnd_n2c(id_zlvl_np)%laction = .TRUE. 1244 ssnd_n2c(id_zlvl_np)%clgrid = 'T' 1245 ssnd_n2c(id_zlvl_np)%nsgn = 1. 1246 ssnd_n2c(id_zlvl_np)%clname = 'zlvl_np' 1247 ssnd_n2c(id_zlvl_np)%nct = 1 1248 ssnd_n2c(id_zlvl_np)%ncplmodel = 1 1249 1250 ssnd_n2c(id_swvdr_np)%laction = .TRUE. 1251 ssnd_n2c(id_swvdr_np)%clgrid = 'T' 1252 ssnd_n2c(id_swvdr_np)%nsgn = 1. 1253 ssnd_n2c(id_swvdr_np)%clname = 'swvdr_np' 1254 ssnd_n2c(id_swvdr_np)%nct = 1 1255 ssnd_n2c(id_swvdr_np)%ncplmodel = 1 1256 1257 ssnd_n2c(id_swvdf_np)%laction = .TRUE. 1258 ssnd_n2c(id_swvdf_np)%clgrid = 'T' 1259 ssnd_n2c(id_swvdf_np)%nsgn = 1. 1260 ssnd_n2c(id_swvdf_np)%clname = 'swvdf_np' 1261 ssnd_n2c(id_swvdf_np)%nct = 1 1262 ssnd_n2c(id_swvdf_np)%ncplmodel = 1 1263 1264 ssnd_n2c(id_swidr_np)%laction = .TRUE. 1265 ssnd_n2c(id_swidr_np)%clgrid = 'T' 1266 ssnd_n2c(id_swidr_np)%nsgn = 1. 1267 ssnd_n2c(id_swidr_np)%clname = 'swidr_np' 1268 ssnd_n2c(id_swidr_np)%nct = 1 1269 ssnd_n2c(id_swidr_np)%ncplmodel = 1 1270 1271 ssnd_n2c(id_swidf_np)%laction = .TRUE. 1272 ssnd_n2c(id_swidf_np)%clgrid = 'T' 1273 ssnd_n2c(id_swidf_np)%nsgn = 1. 1274 ssnd_n2c(id_swidf_np)%clname = 'swidf_np' 1275 ssnd_n2c(id_swidf_np)%nct = 1 1276 ssnd_n2c(id_swidf_np)%ncplmodel = 1 1277 1278 ssnd_n2c(id_fsnow_np)%laction = .TRUE. 1279 ssnd_n2c(id_fsnow_np)%clgrid = 'T' 1280 ssnd_n2c(id_fsnow_np)%nsgn = 1. 1281 ssnd_n2c(id_fsnow_np)%clname = 'fsnow_np' 1282 ssnd_n2c(id_fsnow_np)%nct = 1 1283 ssnd_n2c(id_fsnow_np)%ncplmodel = 1 1284 1285 ssnd_n2c(id_frain_np)%laction = .TRUE. 1286 ssnd_n2c(id_frain_np)%clgrid = 'T' 1287 ssnd_n2c(id_frain_np)%nsgn = 1. 1288 ssnd_n2c(id_frain_np)%clname = 'frain_np' 1289 ssnd_n2c(id_frain_np)%nct = 1 1290 ssnd_n2c(id_frain_np)%ncplmodel = 1 1291 1292 ssnd_n2c(id_sstfrz_np)%laction = .TRUE. 1293 ssnd_n2c(id_sstfrz_np)%clgrid = 'T' 1294 ssnd_n2c(id_sstfrz_np)%nsgn = 1. 1295 ssnd_n2c(id_sstfrz_np)%clname = 'sstfrz_np' 1296 ssnd_n2c(id_sstfrz_np)%nct = 1 1297 ssnd_n2c(id_sstfrz_np)%ncplmodel = 1 1298 1299 ssnd_n2c(id_nfrzmlt_np)%laction = .TRUE. 1300 ssnd_n2c(id_nfrzmlt_np)%clgrid = 'T' 1301 ssnd_n2c(id_nfrzmlt_np)%nsgn = 1. 1302 ssnd_n2c(id_nfrzmlt_np)%clname = 'nfrzmlt_np' 1303 ssnd_n2c(id_nfrzmlt_np)%nct = 1 1304 ssnd_n2c(id_nfrzmlt_np)%ncplmodel = 1 1305 1306 ssnd_n2c(id_sst_m_np)%laction = .TRUE. 1307 ssnd_n2c(id_sst_m_np)%clgrid = 'T' 1308 ssnd_n2c(id_sst_m_np)%nsgn = 1. 1309 ssnd_n2c(id_sst_m_np)%clname = 'sst_m_np' 1310 ssnd_n2c(id_sst_m_np)%nct = 1 1311 ssnd_n2c(id_sst_m_np)%ncplmodel = 1 1312 1313 ssnd_n2c(id_sss_m_np)%laction = .TRUE. 1314 ssnd_n2c(id_sss_m_np)%clgrid = 'T' 1315 ssnd_n2c(id_sss_m_np)%nsgn = 1. 1316 ssnd_n2c(id_sss_m_np)%clname = 'sss_m_np' 1317 ssnd_n2c(id_sss_m_np)%nct = 1 1318 ssnd_n2c(id_sss_m_np)%ncplmodel = 1 1319 1320 ssnd_n2c(id_tsfc_ice_np)%laction = .FALSE. 1321 ssnd_n2c(id_tsfc_ice_np)%clgrid = 'F' 1322 ssnd_n2c(id_tsfc_ice_np)%nsgn = 1. 1323 ssnd_n2c(id_tsfc_ice_np)%clname = 'tsfc_ice_np' 1324 ssnd_n2c(id_tsfc_ice_np)%nct = 5 1325 ssnd_n2c(id_tsfc_ice_np)%ncplmodel = 1 1326 1327 ssnd_n2c(id_uocn_np)%laction = .TRUE. 1328 ssnd_n2c(id_uocn_np)%clgrid = 'T' 1329 ssnd_n2c(id_uocn_np)%nsgn = 1. 1330 ssnd_n2c(id_uocn_np)%clname = 'uocn_np' 1331 ssnd_n2c(id_uocn_np)%nct = 1 1332 ssnd_n2c(id_uocn_np)%ncplmodel = 1 1333 1334 ssnd_n2c(id_vocn_np)%laction = .TRUE. 1335 ssnd_n2c(id_vocn_np)%clgrid = 'F' 1336 ssnd_n2c(id_vocn_np)%nsgn = 1. 1337 ssnd_n2c(id_vocn_np)%clname = 'vocn_np' 1338 ssnd_n2c(id_vocn_np)%nct = 1 1339 ssnd_n2c(id_vocn_np)%ncplmodel = 1 1340 1341 ssnd_n2c(id_ss_tltx_np)%laction = .TRUE. 1342 ssnd_n2c(id_ss_tltx_np)%clgrid = 'F' 1343 ssnd_n2c(id_ss_tltx_np)%nsgn = 1. 1344 ssnd_n2c(id_ss_tltx_np)%clname = 'ss_tltx_np' 1345 ssnd_n2c(id_ss_tltx_np)%nct = 1 1346 ssnd_n2c(id_ss_tltx_np)%ncplmodel = 1 1347 1348 ssnd_n2c(id_ss_tlty_np)%laction = .TRUE. 1349 ssnd_n2c(id_ss_tlty_np)%clgrid = 'F' 1350 ssnd_n2c(id_ss_tlty_np)%nsgn = 1. 1351 ssnd_n2c(id_ss_tlty_np)%clname = 'ss_tlty_np' 1352 ssnd_n2c(id_ss_tlty_np)%nct = 1 1353 ssnd_n2c(id_ss_tlty_np)%ncplmodel = 1 1354 #endif 928 1355 ! ================================ ! 929 1356 ! initialisation of the coupler ! … … 931 1358 932 1359 CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 933 1360 934 1361 IF (ln_usecplmask) THEN 935 1362 xcplmask(:,:,:) = 0. … … 946 1373 IF( ln_dm2dc .AND. ln_cpl .AND. ncpl_qsr_freq /= 86400 ) & 947 1374 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1375 if(ncpl_qsr_freq.LT.1) ncpl_qsr_freq = 1 ! cpl_freq("OCN_O1P") 948 1376 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 949 1377 … … 1091 1519 IF( srcv(jpr_otx2)%laction ) THEN 1092 1520 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1093 ELSE 1521 ELSE 1094 1522 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1095 1523 ENDIF … … 1319 1747 ELSE ; zqsr(:,:) = 0._wp 1320 1748 ENDIF 1321 IF( ln_dm2dc .AND. ln_cpl ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle1749 IF( ln_dm2dc .AND. ln_cpl .AND. .NOT.LOASIS_NEMO_CICE ) zqsr(:,:) = sbc_dcy( zqsr ) ! modify qsr to include the diurnal cycle 1322 1750 IF( ln_mixcpl ) THEN ; qsr(:,:) = qsr(:,:) * xcplmask(:,:,0) + zqsr(:,:) * zmsk(:,:) 1323 1751 ELSE ; qsr(:,:) = zqsr(:,:) … … 1984 2412 & + palbi (:,:,1) * zicefr(:,:) ) ) 1985 2413 END SELECT 1986 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle2414 IF( ln_dm2dc .AND. ln_cpl .AND. .NOT.LOASIS_NEMO_CICE) THEN ! modify qsr to include the diurnal cycle 1987 2415 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1988 2416 DO jl=1,jpl … … 2126 2554 SELECT CASE( sn_snd_temp%clcat ) 2127 2555 CASE( 'yes' ) 2128 2556 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2129 2557 CASE( 'no' ) 2130 2131 2558 ztmp3(:,:,:) = 0.0 2559 DO jl=1,jpl 2132 2560 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2133 2561 ENDDO 2134 2562 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2135 2563 END SELECT … … 2212 2640 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 2213 2641 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2214 2642 END SELECT 2215 2643 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 2216 2644 ENDIF -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r6500 r9132 58 58 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 59 59 swvdr,swvdf,swidr,swidf,Tf, & 60 61 62 63 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 64 64 keffn_top,Tn_top 65 65 … … 73 73 USE CICE_RunMod 74 74 USE CICE_FinalMod 75 USE cpl_oasis3 76 USE mod_oasis 77 USE OASIS_NEMO_CICE 75 78 76 79 IMPLICIT NONE … … 173 176 REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d 174 177 INTEGER :: ji, jj, jl, jk ! dummy loop indices 178 INTEGER, PARAMETER :: zkt = 1 175 179 !!--------------------------------------------------------------------- 176 180 … … 186 190 ! Initialize CICE 187 191 CALL CICE_Initialize 188 189 192 ! Do some CICE consistency checks 190 193 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN … … 202 205 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 203 206 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 205 210 ! Ensure that no temperature points are below freezing if not a NEMO restart 206 211 IF( .NOT. ln_rstart ) THEN … … 214 219 CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d ) 215 220 216 #if defined key_nemocice_decomp217 221 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 218 222 ! there is no restart file. 219 223 ! 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)) 222 225 223 226 ENDIF 224 227 225 228 ! calculate surface freezing temperature and send to CICE 226 CALL 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)) 230 233 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) 231 236 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) ) 233 238 ENDDO 234 239 ENDIF … … 250 255 ! ! embedded sea ice 251 256 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) ) 254 261 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 255 262 snwice_mass_b(:,:) = snwice_mass(:,:) … … 299 306 ENDIF 300 307 ENDIF 301 308 if(lwp) write(numout,*) 'END cice_sbc_init' 309 if(lwp) call flush(numout) 302 310 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 303 311 ! … … 319 327 REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn 320 328 REAL(wp) :: zintb, zintn ! dummy argument 329 INTEGER :: kinfo, isec 321 330 !!--------------------------------------------------------------------- 322 331 … … 330 339 ENDIF 331 340 332 ztmp(:,:)=0.0333 334 341 ! Aggregate ice concentration already set in cice_sbc_out (or cice_sbc_init on 335 342 ! the first time-step) 336 343 337 ! forced and coupled case 338 344 ztmp(:,:)=0.0 339 345 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 340 346 … … 349 355 ENDDO 350 356 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) ) 352 358 353 359 ! y comp of wind stress (CI_2) … … 359 365 ENDDO 360 366 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)) 362 368 363 369 … … 382 388 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 383 389 ENDDO 384 390 ELSE 385 391 !In coupled mode - qla_ice calculated in sbc_cpl for each category 386 392 ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) … … 388 394 389 395 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)) 391 397 392 398 ! GBM conductive flux through ice (CI_6) … … 397 403 ztmp(:,:) = botmelt(:,:,jl) 398 404 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)) 400 406 401 407 ! GBM surface heat flux (CI_7) … … 406 412 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl)) 407 413 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)) 409 415 ENDDO 410 416 … … 414 420 ! x comp and y comp of atmosphere surface wind (CICE expects on T points) 415 421 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) ) 417 423 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) ) 419 425 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) 421 427 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) 423 429 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) 425 431 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) 428 434 ! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows 429 435 ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) ) 430 436 ! 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) 432 438 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) 434 440 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) 436 442 437 443 ! May want to check all values are physically realistic (as in CICE routine … … 440 446 ! Divide shortwave into spectral bands (as in prepare_forcing) 441 447 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) ) 443 449 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) ) 445 451 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) ) 447 453 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) ) 449 455 450 456 ENDIF … … 454 460 IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit 455 461 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) ) 457 463 458 464 ! Rainfall 459 465 IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 460 466 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) ) 462 468 463 469 ! Recalculate freezing temperature and send to CICE 464 470 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) ) 466 472 467 473 ! Freezing/melting potential 468 474 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 469 475 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) ) 471 477 472 478 ! SST and SSS 473 479 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) ) 476 482 477 483 IF( ksbc == jp_purecpl ) THEN 478 484 ! Sea ice surface skin temperature 479 485 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)) 481 487 ENDDO 482 488 ENDIF … … 489 495 ENDDO 490 496 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) ) 492 498 493 499 ! V point to F point … … 497 503 ENDDO 498 504 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) ) 500 506 501 507 IF( nn_ice_embd == 2 ) THEN !== embedded sea ice: compute representative ice top surface ==! … … 525 531 ENDDO 526 532 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) ) 528 534 529 535 ! T point to F point … … 535 541 ENDDO 536 542 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) ) 538 544 539 545 CALL wrk_dealloc( jpi,jpj, ztmp, zpice ) … … 555 561 INTEGER :: ji, jj, jl ! dummy loop indices 556 562 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 563 INTEGER :: kinfo, isec 564 REAL(wp) :: amaxv, aminv 557 565 !!--------------------------------------------------------------------- 558 566 … … 564 572 IF(lwp) WRITE(numout,*)'cice_sbc_out' 565 573 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 567 584 ! 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)) 569 586 ss_iou(:,:)=0.0 570 587 ! F point to U point … … 577 594 578 595 ! 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) ) 580 597 ss_iov(:,:)=0.0 581 598 ! F point to V point … … 598 615 ! Also need ice/ocean stress on T points so that taum can be updated 599 616 ! 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)) 602 619 603 620 ! Update taum with modulus of ice-ocean stress … … 622 639 623 640 #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) ) 626 643 #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) ) 629 646 #endif 630 647 … … 661 678 ! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 662 679 #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) ) 664 681 #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) ) 666 683 #endif 667 684 qsr(:,:)=qsr(:,:)+ztmp1(:,:) … … 675 692 676 693 #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) ) 678 695 #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) ) 680 697 #endif 681 698 qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:) … … 685 702 ! Prepare for the following CICE time-step 686 703 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) ) 688 705 IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 689 706 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) ) 691 708 ENDDO 692 709 ENDIF … … 706 723 ! ! embedded sea ice 707 724 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) ) 710 727 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 711 728 snwice_mass_b(:,:) = snwice_mass(:,:) … … 747 764 ! x and y comp of ice velocity 748 765 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) ) 751 768 752 769 ! Ice concentration (CO_1) = a_i calculated at end of cice_sbc_out … … 755 772 756 773 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)) 759 776 ENDDO 760 777 … … 762 779 ! Meltpond fraction and depth 763 780 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) ) 766 783 ENDDO 767 784 #endif … … 776 793 IF (heat_capacity) THEN 777 794 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) ) 780 797 ENDDO 781 798 ! Convert surface temperature to Kelvin … … 926 943 END SUBROUTINE cice_sbc_force 927 944 928 SUBROUTINE nemo2cice( pn, pc, cd_type, psgn )945 SUBROUTINE nemo2cice( pn, pc, cd_type, psgn, kt, idn, idc) 929 946 !!--------------------------------------------------------------------- 930 947 !! *** ROUTINE nemo2cice *** … … 944 961 #endif 945 962 !!--------------------------------------------------------------------- 946 963 INTEGER, INTENT( in ) :: idn, idc 947 964 CHARACTER(len=1), INTENT( in ) :: & 948 965 cd_type ! nature of pn grid-point … … 952 969 ! ! =-1 , the sign is modified following the type of b.c. used 953 970 ! ! = 1 , no sign change 971 INTEGER, INTENT(IN) :: kt 954 972 REAL(wp), DIMENSION(jpi,jpj) :: pn 955 #if !defined key_nemocice_decomp956 REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2957 REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg958 #endif959 973 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 960 974 INTEGER (int_kind) :: & … … 964 978 965 979 INTEGER :: ji, jj, jn ! dummy loop indices 980 INTEGER :: isec, kinfo, iblk 981 type (block) :: bk 966 982 967 983 ! A. Ensure all haloes are filled in NEMO field (pn) … … 980 996 981 997 #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 ) 1014 1036 #endif 1015 1037 … … 1033 1055 #else 1034 1056 ! 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) 1036 1060 #endif 1037 1061 1038 1062 END SUBROUTINE nemo2cice 1039 1063 1040 SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn )1064 SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn, kt, idc, idn ) 1041 1065 !!--------------------------------------------------------------------- 1042 1066 !! *** ROUTINE cice2nemo *** … … 1065 1089 ! ! = 1 , no sign change 1066 1090 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 1069 1095 INTEGER (int_kind) :: & 1070 1096 field_type, & ! id for type of field (scalar, vector, angle) 1071 1097 grid_loc ! id for location on horizontal grid 1072 1098 ! (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 1076 1103 1077 1104 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 1078 1105 1079 1106 INTEGER :: ji, jj, jn ! dummy loop indices 1080 1081 1082 #if defined key_nemocice_decomp 1107 INTEGER :: kinfo, isec, iblk 1083 1108 1084 1109 SELECT CASE ( cd_type ) … … 1098 1123 CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type) 1099 1124 1100 1125 #if defined key_nemocice_decomp 1101 1126 pn(:,:)=0.0 1102 1127 DO jj=1,jpjm1 … … 1108 1133 #else 1109 1134 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, but1119 ! the lbclnk call on pn will replace these with sensible values1120 1121 IF (nproc==0) THEN1122 png(:,:,:)=0.01123 DO jn=1,jpnij1124 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 ENDDO1128 ENDDO1129 ENDDO1130 ENDIF1135 !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 1131 1156 1132 1157 ! C. Scatter png into NEMO field (pn) for each processor 1133 1158 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 ) 1142 1171 #endif 1143 1172 … … 1156 1185 1157 1186 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1187 INTEGER, INTENT(IN) :: kt, ksbc 1158 1188 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1159 1189 END SUBROUTINE sbc_ice_cice 1160 1190 1161 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1191 SUBROUTINE cice_sbc_init (kt, ksbc) ! Dummy routine 1192 INTEGER, INTENT(IN) :: kt, ksbc 1162 1193 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1163 1194 END SUBROUTINE cice_sbc_init -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6498 r9132 267 267 ! 268 268 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 269 ! ! (2) the use of nn_fsbc 270 269 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 270 call flush(numout) 271 ! (2) the use of nn_fsbc 271 272 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 272 273 ! sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly … … 304 305 IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialisation 305 306 306 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation307 308 307 END SUBROUTINE sbc_init 309 308 -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6487 r9132 370 370 END DO 371 371 WRITE(numout,cform_aaa) ! Flag AAAAAAA 372 call flush(numout) 372 373 ! 373 374 ENDIF … … 475 476 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 476 477 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 478 call flush(numout) 477 479 ! 478 480 END SUBROUTINE nemo_init -
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/oce.F90
r6755 r9132 32 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] 33 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rhop !: potential volumic mass [kg/m3] 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vcice 34 35 35 36 !! free surface ! before ! now ! after ! … … 97 98 !! *** FUNCTION oce_alloc *** 98 99 !!---------------------------------------------------------------------- 99 INTEGER :: ierr( 4)100 INTEGER :: ierr(5) 100 101 !!---------------------------------------------------------------------- 101 102 ! … … 129 130 & riceload(jpi,jpj), STAT=ierr(2) ) 130 131 ! 132 ALLOCATE(vcice (jpi,jpj)) 131 133 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 132 134 !
Note: See TracChangeset
for help on using the changeset viewer.
