Changeset 14221
- Timestamp:
- 2020-12-18T20:25:45+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/BDY/bdytides.F90
r14219 r14221 162 162 ! 163 163 ! SSH fields 164 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain165 clfile = TRIM(filtide)//'_grid_T.nc'166 CALL iom_open( clfile , inum )167 igrd = 1 ! Everything is at T-points here168 DO itide = 1, nb_harmo169 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) )170 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )164 clfile = TRIM(filtide)//'_grid_T.nc' 165 CALL iom_open( clfile , inum ) 166 igrd = 1 ! Everything is at T-points here 167 DO itide = 1, nb_harmo 168 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 169 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 170 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 171 171 DO ib = 1, SIZE(dta%ssh) 172 172 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 175 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 176 END DO 177 END DO178 CALL iom_close( inum )179 ENDIF177 ENDIF 178 END DO 179 CALL iom_close( inum ) 180 180 ! 181 181 ! U fields 182 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain183 clfile = TRIM(filtide)//'_grid_U.nc'184 CALL iom_open( clfile , inum )185 igrd = 2 ! Everything is at U-points here186 DO itide = 1, nb_harmo187 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp)188 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp)182 clfile = TRIM(filtide)//'_grid_U.nc' 183 CALL iom_open( clfile , inum ) 184 igrd = 2 ! Everything is at U-points here 185 DO itide = 1, nb_harmo 186 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp) 187 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp) 188 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 189 189 DO ib = 1, SIZE(dta%u2d) 190 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 193 193 td%u0(ib,itide,2) = zti(ii,ij) 194 194 END DO 195 END DO196 CALL iom_close( inum )197 ENDIF195 ENDIF 196 END DO 197 CALL iom_close( inum ) 198 198 ! 199 199 ! V fields 200 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain201 clfile = TRIM(filtide)//'_grid_V.nc'202 CALL iom_open( clfile , inum )203 igrd = 3 ! Everything is at V-points here204 DO itide = 1, nb_harmo205 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp)206 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp)200 clfile = TRIM(filtide)//'_grid_V.nc' 201 CALL iom_open( clfile , inum ) 202 igrd = 3 ! Everything is at V-points here 203 DO itide = 1, nb_harmo 204 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp) 205 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp) 206 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 207 207 DO ib = 1, SIZE(dta%v2d) 208 208 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) … … 211 211 td%v0(ib,itide,2) = zti(ii,ij) 212 212 END DO 213 END DO214 CALL iom_close( inum )215 ENDIF213 ENDIF 214 END DO 215 CALL iom_close( inum ) 216 216 ! 217 217 DEALLOCATE( ztr, zti ) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/DYN/dynhpg.F90
r14219 r14221 991 991 zcoef0 = - grav 992 992 znad = 1._wp 993 IF( ln_linssh ) znad = 0._wp 993 IF( ln_linssh ) znad = 1._wp 994 ! 995 ! --------------- 996 ! Surface pressure gradient to be removed 997 ! --------------- 998 DO_2D( 0, 0, 0, 0 ) 999 zpgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 1000 zpgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 1001 END_2D 1002 ! 994 1003 995 1004 IF( ln_wd_il ) THEN -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/in_out_manager.F90
r14219 r14221 1 MODULE in_out_manager 1 MODULE in_out_manager 2 2 !!====================================================================== 3 3 !! *** MODULE in_out_manager *** -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/IOM/prtctl.F90
r14219 r14221 310 310 WRITE(numout,*) '~~~~~~~~~~~~~' 311 311 ENDIF 312 IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 ) THEN ! print control done over the default area 312 IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 ) THEN ! print control done over the default area 313 313 nn_isplt = MAX(1, nn_isplt) ! number of processors following i-direction 314 314 nn_jsplt = MAX(1, nn_jsplt) ! number of processors following j-direction -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfutils.F90
r14219 r14221 16 16 USE par_oce , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0 ! domain size 17 17 USE dom_oce , ONLY: narea, tmask_h, tmask_i ! local domain 18 USE in_out_manager, ONLY: lwp, numout ! miscelenious 19 USE par_kind 18 USE in_out_manager, ONLY: i8, wp, lwp, numout ! miscelenious 20 19 USE lib_mpp 21 20 -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/cpl_oasis3.F90
r14219 r14221 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 0! Maximum number of coupling fields68 INTEGER, PUBLIC, PARAMETER :: nmaxfld=62 ! 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/sbcflx.F90
r14219 r14221 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( ji,jj,1)129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,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( '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 ) 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 ) 158 149 ! 159 150 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 160 WRITE(numout,*) 151 WRITE(numout,*) 161 152 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 162 153 DO jf = 1, jpfld … … 164 155 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 165 156 IF( jf == jp_emp ) zfact = 86400. 166 WRITE(numout,*) 157 WRITE(numout,*) 167 158 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 168 159 END DO … … 175 166 DO_2D( 0, 0, 0, 0 ) 176 167 ztx = ( utau(ji-1,jj ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj ,1), umask(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) ) ) 168 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 178 169 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 179 170 taum(ji,jj) = zmod … … 181 172 END_2D 182 173 ! 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 ) 174 CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 186 175 ! 187 176 END SUBROUTINE sbc_flx … … 189 178 !!====================================================================== 190 179 END MODULE sbcflx 191 -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/TRA/traldf_iso.F90
r14219 r14221 198 198 ! 199 199 IF( ln_traldf_blp ) THEN ! bilaplacian operator 200 DO_3D( 1, 0, 1, 0, 2, jpkm1 )200 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 201 201 akz(ji,jj,jk) = 16._wp & 202 202 & * ah_wslp2 (ji,jj,jk) & -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/AGE/trcsms_age.F90
r14219 r14221 29 29 REAL(wp), PUBLIC :: frac_add_age !: fraction of level nl_age below age_depth where it is incremented 30 30 31 # include "single_precision_substitute.h90" 31 # include "single_precision_substitute.h90" 32 32 33 33 !!---------------------------------------------------------------------- … … 57 57 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 58 58 59 IF( l_1st_euler .OR. ln_top_euler ) THEN 60 tr(:,:,:,jp_age,Kbb) = tr(:,:,:,jp_age,Kmm) 61 ENDIF 62 59 63 60 64 DO jk = 1, nla_age -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/TOP/C14/trcsms_c14.F90
r14219 r14221 144 144 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 145 145 ! 146 CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) 147 CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc ) 146 CALL iom_rstput( kt, nitrst, numrtw, 'co2sbc', co2sbc ) ! These five need & 147 CALL iom_rstput( kt, nitrst, numrtw, 'c14sbc', c14sbc ) ! & to be written & 148 148 CALL iom_rstput( kt, nitrst, numrtw, 'exch_co2', exch_co2 ) ! & for temporal & 149 149 CALL iom_rstput( kt, nitrst, numrtw, 'exch_c14', exch_c14 ) ! & averages & 150 CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 )! & to be coherent.150 CALL iom_rstput( kt, nitrst, numrtw, 'qtr_c14', qtr_c14 ) ! & to be coherent. 151 151 CALL iom_rstput( kt, nitrst, numrtw, 'qint_c14', qint_c14 ) ! Cumulative 152 152 !
Note: See TracChangeset
for help on using the changeset viewer.