Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC
- Timestamp:
- 2020-12-18T18:52:57+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC
- Files:
-
- 11 edited
-
cpl_oasis3.F90 (modified) (22 diffs)
-
fldread.F90 (modified) (1 diff)
-
geo2ocean.F90 (modified) (3 diffs)
-
sbc_phy.F90 (modified) (1 diff)
-
sbcblk.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (5 diffs)
-
sbcflx.F90 (modified) (11 diffs)
-
sbcfwb.F90 (modified) (2 diffs)
-
sbcmod.F90 (modified) (5 diffs)
-
sbcssm.F90 (modified) (2 diffs)
-
sbcwave.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/cpl_oasis3.F90
r14072 r14219 14 14 !! 3.6 ! 2014-11 (S. Masson) OASIS3-MCT 15 15 !!---------------------------------------------------------------------- 16 16 17 17 !!---------------------------------------------------------------------- 18 18 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT … … 63 63 #endif 64 64 65 INTEGER :: nrcv ! total number of fields received 66 INTEGER :: nsnd ! total number of fields sent 65 INTEGER :: nrcv ! total number of fields received 66 INTEGER :: nsnd ! total number of fields sent 67 67 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=6 2! Maximum number of coupling fields68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=60 ! Maximum number of coupling fields 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 71 72 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 73 73 LOGICAL :: laction ! To be coupled or not 74 CHARACTER(len = 8) :: clname ! Name of the coupling field 75 CHARACTER(len = 1) :: clgrid ! Grid type 74 CHARACTER(len = 8) :: clname ! Name of the coupling field 75 CHARACTER(len = 1) :: clgrid ! Grid type 76 76 REAL(wp) :: nsgn ! Control of the sign change 77 77 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) … … 98 98 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 99 99 !! 100 !! ** Method : OASIS3 MPI communication 100 !! ** Method : OASIS3 MPI communication 101 101 !!-------------------------------------------------------------------- 102 102 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file … … 132 132 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 133 133 !! 134 !! ** Method : OASIS3 MPI communication 134 !! ** Method : OASIS3 MPI communication 135 135 !!-------------------------------------------------------------------- 136 136 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields … … 180 180 ! 181 181 ! ----------------------------------------------------------------- 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 183 183 ! ----------------------------------------------------------------- 184 184 185 185 paral(1) = 2 ! box partitioning 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 187 187 paral(3) = Ni_0 ! local extent in i, excluding halos 188 188 paral(4) = Nj_0 ! local extent in j, excluding halos 189 189 paral(5) = Ni0glo ! global extent in x, excluding halos 190 190 191 191 IF( sn_cfctl%l_oasout ) THEN 192 192 WRITE(numout,*) ' multiexchg: paral (1:5)', paral … … 195 195 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 196 196 ENDIF 197 197 198 198 CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo ) ! global number of points, excluding halos 199 199 ! 200 ! ... Announce send variables. 200 ! ... Announce send variables. 201 201 ! 202 202 ssnd(:)%ncplmodel = kcplmodel … … 210 210 RETURN 211 211 ENDIF 212 212 213 213 DO jc = 1, ssnd(ji)%nct 214 214 DO jm = 1, kcplmodel … … 225 225 ENDIF 226 226 #if defined key_agrif 227 IF( agrif_fixed() /= 0 ) THEN 227 IF( agrif_fixed() /= 0 ) THEN 228 228 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 229 229 ENDIF … … 243 243 END DO 244 244 ! 245 ! ... Announce received variables. 245 ! ... Announce received variables. 246 246 ! 247 247 srcv(:)%ncplmodel = kcplmodel 248 248 ! 249 249 DO ji = 1, krcv 250 IF( srcv(ji)%laction ) THEN 251 250 IF( srcv(ji)%laction ) THEN 251 252 252 IF( srcv(ji)%nct > nmaxcat ) THEN 253 253 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & … … 255 255 RETURN 256 256 ENDIF 257 257 258 258 DO jc = 1, srcv(ji)%nct 259 259 DO jm = 1, kcplmodel 260 260 261 261 IF( srcv(ji)%nct .GT. 1 ) THEN 262 262 WRITE(cli2,'(i2.2)') jc … … 270 270 ENDIF 271 271 #if defined key_agrif 272 IF( agrif_fixed() /= 0 ) THEN 272 IF( agrif_fixed() /= 0 ) THEN 273 273 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 274 274 ENDIF … … 288 288 ENDIF 289 289 END DO 290 290 291 291 !------------------------------------------------------------------ 292 292 ! End of definition phase 293 293 !------------------------------------------------------------------ 294 ! 294 ! 295 295 #if defined key_agrif 296 296 IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN … … 303 303 ! 304 304 END SUBROUTINE cpl_define 305 306 305 306 307 307 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 308 308 !!--------------------------------------------------------------------- … … 324 324 DO jc = 1, ssnd(kid)%nct 325 325 DO jm = 1, ssnd(kid)%ncplmodel 326 326 327 327 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN ! exclude halos from data sent to oasis 328 328 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 329 330 IF ( sn_cfctl%l_oasout ) THEN 329 330 IF ( sn_cfctl%l_oasout ) THEN 331 331 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 332 332 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN … … 342 342 ENDIF 343 343 ENDIF 344 344 345 345 ENDIF 346 346 347 347 ENDDO 348 348 ENDDO … … 379 379 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 380 380 381 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 382 381 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 382 383 383 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 384 384 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 385 385 386 386 IF ( sn_cfctl%l_oasout ) & 387 387 & WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 388 388 389 389 IF( llaction ) THEN ! data received from oasis do not include halos 390 390 391 391 kinfo = OASIS_Rcv 392 IF( ll_1st ) THEN 392 IF( ll_1st ) THEN 393 393 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 394 394 ll_1st = .FALSE. … … 397 397 & + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 398 398 ENDIF 399 400 IF ( sn_cfctl%l_oasout ) THEN 399 400 IF ( sn_cfctl%l_oasout ) THEN 401 401 WRITE(numout,*) '****************' 402 402 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname … … 409 409 WRITE(numout,*) '****************' 410 410 ENDIF 411 411 412 412 ENDIF 413 413 414 414 ENDIF 415 415 416 416 ENDDO 417 417 418 418 !--- we must call lbc_lnk to fill the halos that where not received. 419 419 IF( .NOT. ll_1st ) THEN 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 421 421 ENDIF 422 422 423 423 ENDDO 424 424 ! … … 426 426 427 427 428 INTEGER FUNCTION cpl_freq( cdfieldname ) 428 INTEGER FUNCTION cpl_freq( cdfieldname ) 429 429 !!--------------------------------------------------------------------- 430 430 !! *** ROUTINE cpl_freq *** … … 491 491 DEALLOCATE( exfld ) 492 492 IF(nstop == 0) THEN 493 CALL oasis_terminate( nerror ) 493 CALL oasis_terminate( nerror ) 494 494 ELSE 495 495 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 496 ENDIF 496 ENDIF 497 497 ! 498 498 END SUBROUTINE cpl_finalize … … 544 544 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 545 545 END SUBROUTINE oasis_enddef 546 546 547 547 SUBROUTINE oasis_put(k1,k2,p1,k3) 548 548 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 … … 574 574 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 575 575 END SUBROUTINE oasis_terminate 576 576 577 577 #endif 578 578 -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/fldread.F90
r13546 r14219 383 383 IF( lk_c1d .AND. lmoor ) THEN 384 384 CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, dta_alias(2,2,:), sdjf%nrec(1,iaa) ) ! jpdom_unknown -> no lbc_lnk 385 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1. , kfillmode = jpfillcopy )385 CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1._wp, kfillmode = jpfillcopy ) 386 386 ELSE 387 387 CALL iom_get( sdjf%num, jpdom_global, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa), & -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/geo2ocean.F90
r13295 r14219 44 44 !! * Substitutions 45 45 # include "do_loop_substitute.h90" 46 # include "single_precision_substitute.h90" 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 73 74 IF(lwp) WRITE(numout,*) ' ~~~~~~~~ ' 74 75 ! 75 CALL angle( glamt, gphit, glamu, gphiu, glamv, gphiv, glamf, gphif) ! initialization of the transformation76 CALL angle( CASTWP(glamt), CASTWP(gphit), glamu, gphiu, glamv, gphiv, CASTWP(glamf), CASTWP(gphif) ) ! initialization of the transformation 76 77 lmust_init = .FALSE. 77 78 ENDIF … … 449 450 IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 450 451 IF(lwp) WRITE(numout,*) ' ~~~~~~~ coordinate transformation' 451 CALL angle( glamt, gphit, glamu, gphiu, glamv, gphiv, glamf, gphif) ! initialization of the transformation452 CALL angle( CASTWP(glamt), CASTWP(gphit), glamu, gphiu, glamv, gphiv, CASTWP(glamf), CASTWP(gphif) ) ! initialization of the transformation 452 453 lmust_init = .FALSE. 453 454 ENDIF -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbc_phy.F90
r14110 r14219 770 770 ztaa = pTa ! first guess... 771 771 DO jq = 1, 4 772 zgamma = gamma_moist( 0.5 *(ztaa+pTs) , pqa ) !#LB: why not "0.5*(pqs+pqa)" rather then "pqa" ???772 zgamma = gamma_moist( 0.5_wp*(ztaa+pTs) , pqa ) !#LB: why not "0.5*(pqs+pqa)" rather then "pqa" ??? 773 773 ztaa = pTa - zgamma*pzu ! Absolute temp. is slightly colder... 774 774 END DO -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90
r14072 r14219 830 830 831 831 IF( ln_crt_fbk ) THEN 832 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1. , vtau, 'V', -1., taum, 'T', -1.)832 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', -1._wp ) 833 833 ELSE 834 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1. , vtau, 'V', -1.)834 CALL lbc_lnk_multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 835 835 ENDIF 836 836 … … 1197 1197 ! --- evaporation minus precipitation --- ! 1198 1198 zsnw(:,:) = 0._wp 1199 CALL ice_var_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing1199 CALL ice_var_snwblow( 1._wp-at_i_b(:,:), zsnw ) ! snow distribution over ice after wind blowing 1200 1200 emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 1201 1201 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90
r14100 r14219 226 226 # include "do_loop_substitute.h90" 227 227 # include "domzgr_substitute.h90" 228 # include "single_precision_substitute.h90" 228 229 !!---------------------------------------------------------------------- 229 230 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 1666 1667 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1667 1668 END_2D 1668 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1. , p_tauj, 'V', -1.)1669 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1._wp, p_tauj, 'V', -1._wp ) 1669 1670 END SELECT 1670 1671 … … 2278 2279 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2279 2280 ELSE 2280 ! we must send the surface potential temperature 2281 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )2281 ! we must send the surface potential temperature 2282 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)),CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 2282 2283 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) 2283 2284 ENDIF … … 2713 2714 ! ! SSS 2714 2715 IF( ssnd(jps_soce )%laction ) THEN 2715 CALL cpl_snd( jps_soce , isec, RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) ), info )2716 CALL cpl_snd( jps_soce , isec, RESHAPE ( CASTWP(ts(:,:,1,jp_sal,Kmm)), (/jpi,jpj,1/) ), info ) 2716 2717 ENDIF 2717 2718 ! ! first T level thickness 2718 2719 IF( ssnd(jps_e3t1st )%laction ) THEN 2719 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) ), info )2720 CALL cpl_snd( jps_e3t1st, isec, RESHAPE ( CASTWP(e3t(:,:,1,Kmm)) , (/jpi,jpj,1/) ), info ) 2720 2721 ENDIF 2721 2722 ! ! Qsr fraction … … 2740 2741 ! ! ------------------------- ! 2741 2742 ! needed by Met Office 2742 CALL eos_fzp( ts(:,:,1,jp_sal,Kmm), sstfrz)2743 CALL eos_fzp(CASTWP(ts(:,:,1,jp_sal,Kmm)), sstfrz) 2743 2744 ztmp1(:,:) = sstfrz(:,:) + rt0 2744 2745 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcflx.F90
r14072 r14219 35 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 36 !!INTEGER , PARAMETER :: jp_sfx = 6 ! index of salt flux flux 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 38 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 39 39 … … 50 50 !!--------------------------------------------------------------------- 51 51 !! *** ROUTINE sbc_flx *** 52 !! 52 !! 53 53 !! ** Purpose : provide at each time step the surface ocean fluxes 54 !! (momentum, heat, freshwater and runoff) 54 !! (momentum, heat, freshwater and runoff) 55 55 !! 56 56 !! ** Method : - READ each fluxes in NetCDF files: … … 91 91 !!--------------------------------------------------------------------- 92 92 ! 93 IF( kt == nit000 ) THEN ! First call kt=nit000 93 IF( kt == nit000 ) THEN ! First call kt=nit000 94 94 ! set file information 95 95 READ ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) … … 98 98 READ ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 99 99 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' ) 100 IF(lwm) WRITE ( numond, namsbc_flx ) 100 IF(lwm) WRITE ( numond, namsbc_flx ) 101 101 ! 102 102 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 103 103 IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. ) & 104 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 104 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 105 105 ! 106 106 ! ! store namelist information in an array 107 107 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 108 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 108 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 109 109 slf_i(jp_emp ) = sn_emp !! ; slf_i(jp_sfx ) = sn_sfx 110 110 ! 111 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 112 IF( ierror > 0 ) THEN 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 112 IF( ierror > 0 ) THEN 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 114 114 ENDIF 115 115 DO ji= 1, jpfld … … 123 123 124 124 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 125 125 126 126 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 127 127 128 128 IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle 129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask( :,:,1)129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(ji,jj,1) 130 130 ELSE 131 131 DO_2D( 0, 0, 0, 0 ) … … 138 138 qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 139 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1) 140 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 140 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 141 141 END_2D 142 142 ! ! add to qns the heat due to e-p … … 144 144 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 145 145 ! 146 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 147 CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 148 & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp ) 146 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 147 CALL lbc_lnk( 'sbcflx', utau, 'U', -1._wp) 148 CALL lbc_lnk( 'sbcflx', vtau, 'V', -1._wp) 149 CALL lbc_lnk( 'sbcflx', qns, 'T', 1._wp) 150 CALL lbc_lnk( 'sbcflx', emp, 'T', 1._wp) 151 CALL lbc_lnk( 'sbcflx', qsr, 'T', 1._wp) 152 153 ! 154 ! 155 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 156 !CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 157 ! & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp ) 149 158 ! 150 159 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 151 WRITE(numout,*) 160 WRITE(numout,*) 152 161 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 153 162 DO jf = 1, jpfld … … 155 164 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 156 165 IF( jf == jp_emp ) zfact = 86400. 157 WRITE(numout,*) 166 WRITE(numout,*) 158 167 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 159 168 END DO … … 166 175 DO_2D( 0, 0, 0, 0 ) 167 176 ztx = ( utau(ji-1,jj ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj ,1), umask(ji,jj,1) ) ) 168 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 177 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 169 178 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 170 179 taum(ji,jj) = zmod … … 172 181 END_2D 173 182 ! 174 CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 183 CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp) 184 CALL lbc_lnk( 'sbcflx', wndm, 'T', 1._wp) 185 ! CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 175 186 ! 176 187 END SUBROUTINE sbc_flx … … 178 189 !!====================================================================== 179 190 END MODULE sbcflx 191 -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcfwb.F90
r14200 r14219 39 39 ! previous year 40 40 REAL(wp) :: area ! global mean ocean surface (interior domain) 41 42 # include "single_precision_substitute.h90" 41 43 42 44 !!---------------------------------------------------------------------- … … 117 119 ! 118 120 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 119 y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:)) )121 y_fwfnow(1) = local_sum( CASTWP(e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) - snwice_fmass(:,:) )) ) 120 122 CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 ) 121 123 z_fwfprv(1) = z_fwfprv(1) / area -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcmod.F90
r14072 r14219 75 75 !! * Substitutions 76 76 # include "do_loop_substitute.h90" 77 # include "single_precision_substitute.h90" 77 78 !!---------------------------------------------------------------------- 78 79 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 441 442 END_2D 442 443 ! 443 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 444 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 444 CALL lbc_lnk_multi( 'sbcwave', utau, 'U', -1._wp , vtau, 'V', -1._wp ) 445 445 ! 446 446 taum(:,:) = taum(:,:)*tauoc_wave(:,:) … … 452 452 utau(:,:) = utau(:,:) - tawx(:,:) + twox(:,:) 453 453 vtau(:,:) = vtau(:,:) - tawy(:,:) + twoy(:,:) 454 CALL lbc_lnk( 'sbcwave', utau, 'U', -1. ) 455 CALL lbc_lnk( 'sbcwave', vtau, 'V', -1. ) 454 CALL lbc_lnk_multi( 'sbcwave', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 456 455 ! 457 456 DO_2D( 0, 0, 0, 0) … … 463 462 ! 464 463 ENDIF 465 CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1. )464 CALL lbc_lnk( 'sbcmod', taum(:,:), 'T', 1._wp ) 466 465 ! 467 466 ! !== Misc. Options ==! … … 586 585 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask ) 587 586 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk ) 588 CALL prt_ctl(tab3d_1= ts(:,:,:,jp_tem,Kmm), clinfo1=' sst - : ', mask1=tmask, kdim=1 )589 CALL prt_ctl(tab3d_1= ts(:,:,:,jp_sal,Kmm), clinfo1=' sss - : ', mask1=tmask, kdim=1 )587 CALL prt_ctl(tab3d_1=CASTWP(ts(:,:,:,jp_tem,Kmm)), clinfo1=' sst - : ', mask1=tmask, kdim=1 ) 588 CALL prt_ctl(tab3d_1=CASTWP(ts(:,:,:,jp_sal,Kmm)), clinfo1=' sss - : ', mask1=tmask, kdim=1 ) 590 589 CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, & 591 590 & tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask ) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcssm.F90
r14072 r14219 33 33 34 34 # include "domzgr_substitute.h90" 35 # include "single_precision_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 241 242 ssu_m(:,:) = uu(:,:,1,Kbb) 242 243 ssv_m(:,:) = vv(:,:,1,Kbb) 243 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( ts(:,:,1,jp_tem,Kmm), ts(:,:,1,jp_sal,Kmm) )244 IF( l_useCT ) THEN ; sst_m(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)), CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 244 245 ELSE ; sst_m(:,:) = ts(:,:,1,jp_tem,Kmm) 245 246 ENDIF -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcwave.F90
r14072 r14219 71 71 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: div_sd !: barotropic stokes drift divergence 72 72 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ut0sd, vt0sd !: surface Stokes drift velocities at t-point 73 REAL( wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd, wsd !: Stokes drift velocities at u-, v- & w-points, resp.u73 REAL(dp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd, vsd, wsd !: Stokes drift velocities at u-, v- & w-points, resp.u 74 74 ! 75 75 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: charn !: charnock coefficient at t-point
Note: See TracChangeset
for help on using the changeset viewer.
