Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcflx.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbcflx.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/SBC/sbcflx.F90
r13497 r14789 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 … … 119 119 ! ! fill sf with slf_i and control print 120 120 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 121 sf(jp_utau)%cltype = 'U' ; sf(jp_utau)%zsgn = -1._wp ! vector field at U point: overwrite default definition of cltype and zsgn 122 sf(jp_vtau)%cltype = 'V' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at V point: overwrite default definition of cltype and zsgn 121 123 ! 122 124 ENDIF 123 125 124 126 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 125 127 126 128 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 127 129 128 130 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)131 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 130 132 ELSE 131 DO_2D( 0, 0, 0, 0)132 qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1)* tmask(ji,jj,1)133 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 134 qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 133 135 END_2D 134 136 ENDIF 135 DO_2D( 0, 0, 0, 0 )! set the ocean fluxes from read fields137 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the ocean fluxes from read fields 136 138 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) 137 139 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) 138 140 qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 139 141 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) 142 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 141 143 END_2D 142 144 ! ! add to qns the heat due to e-p … … 144 146 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 145 147 ! 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 )149 !150 148 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 151 WRITE(numout,*) 149 WRITE(numout,*) 152 150 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 153 151 DO jf = 1, jpfld … … 155 153 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 156 154 IF( jf == jp_emp ) zfact = 86400. 157 WRITE(numout,*) 155 WRITE(numout,*) 158 156 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 159 157 END DO … … 166 164 DO_2D( 0, 0, 0, 0 ) 167 165 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) ) ) 166 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 169 167 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 170 168 taum(ji,jj) = zmod … … 172 170 END_2D 173 171 ! 174 CALL lbc_lnk _multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp )172 CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 175 173 ! 176 174 END SUBROUTINE sbc_flx
Note: See TracChangeset
for help on using the changeset viewer.
