Changeset 5835 for branches/NERC
- Timestamp:
- 2015-10-26T15:41:05+01:00 (9 years ago)
- Location:
- branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r5823 r5835 82 82 pvol_flx(:,:,: ) = 0.0_wp 83 83 pts_flx (:,:,:,:) = 0.0_wp 84 r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt) 84 85 85 86 ! mask tsn and tsb … … 87 88 tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:); 88 89 89 ! diagnose non conservation of heat, salt and volume 90 r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt) 91 90 !============================================================================== 91 ! diagnose the heat, salt and volume input and compute the correction variable 92 !============================================================================== 93 94 ! 92 95 zssh0(:,:) = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:) 93 96 IF ( lk_vvl ) zssh0 = 0.0_wp ! already include in the levels by definition 94 97 95 98 DO jk = 1,jpk-1 96 99 DO ji = 2,jpi-1 … … 119 122 pts_flx (ji,jj,jk,jp_tem)= pts_flx (ji,jj,jk,jp_tem) + zdtem(ji,jj) * r1_tiscpl 120 123 124 ! case where we close a cell: check if the neighbour cells are wet 121 125 IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN 122 ! case where we close a cell: check if the neighbour cells are wet123 126 124 127 jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ; -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90
r5823 r5835 8 8 9 9 !!---------------------------------------------------------------------- 10 !! iscpl_ rst : restart correction in case of coupling with ice sheet11 !! iscpl_ rst_interpol : restart interpolation in case of coupling with ice sheet10 !! iscpl_init : initialisation routine (namelist) 11 !! iscpl_alloc : allocation of correction variables 12 12 !!---------------------------------------------------------------------- 13 13 USE dom_oce ! ocean space and time domain -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r5823 r5835 8 8 9 9 !!---------------------------------------------------------------------- 10 !! iscpl_stp : step management 10 11 !! iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet 11 12 !!---------------------------------------------------------------------- … … 68 69 CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b ) ! need to correct barotropic velocity 69 70 CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b ) ! need to correct barotropic velocity 70 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n' , ze3t_b(:,:,:) )! need to compute temperature correction71 CALL iom_get( numror, jpdom_autoglo, 'fse3u_n' , ze3u_b(:,:,:) ) ! need to compute volume correction ????72 CALL iom_get( numror, jpdom_autoglo, 'fse3v_n' , ze3v_b(:,:,:) ) ! need to compute volume correction ????73 CALL iom_get( numror, jpdom_autoglo, 'fsdepw_n', zdepw_b(:,:,:) ) ! need to compute volume correction ????71 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n' , ze3t_b(:,:,:) ) ! need to compute temperature correction 72 CALL iom_get( numror, jpdom_autoglo, 'fse3u_n' , ze3u_b(:,:,:) ) ! need to correct barotropic velocity 73 CALL iom_get( numror, jpdom_autoglo, 'fse3v_n' , ze3v_b(:,:,:) ) ! need to correct barotropic velocity 74 CALL iom_get( numror, jpdom_autoglo, 'fsdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 74 75 75 76 !! read namelist … … 105 106 !! next step is an euler time step 106 107 neuler = 0 108 107 109 !! set _b and _n variables equal 108 110 tsb (:,:,:,:) = tsn (:,:,:,:) … … 110 112 vb (:,:,: ) = vn (:,:,: ) 111 113 sshb(:,: ) = sshn(:,:) 114 112 115 !! set _b and _n vertical scale factor equal 113 116 fse3t_b (:,:,:) = fse3t_n (:,:,:) … … 158 161 !! allocate variables 159 162 CALL wrk_alloc(jpi,jpj,jpk,2, zts0 ) 160 CALL wrk_alloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp, ztmp3d 163 CALL wrk_alloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp, ztmp3d ) 161 164 CALL wrk_alloc(jpi,jpj,jpk, zwmaskn, zwmaskb ) 162 165 CALL wrk_alloc(jpi,jpj, zsmask0, zsmask1 ) -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5779 r5835 1399 1399 !! *** routine mpp_lnk_sum_3d *** 1400 1400 !! 1401 !! ** Purpose : Message passing manadgement (sum inthe overlap region)1401 !! ** Purpose : Message passing manadgement (sum the overlap region) 1402 1402 !! 1403 1403 !! ** Method : Use mppsend and mpprecv function for passing mask … … 1572 1572 !! *** routine mpp_lnk_sum_2d *** 1573 1573 !! 1574 !! ** Purpose : Message passing manadgement for 2d array (sum inthe overlap region)1574 !! ** Purpose : Message passing manadgement for 2d array (sum the overlap region) 1575 1575 !! 1576 1576 !! ** Method : Use mppsend and mpprecv function for passing mask -
branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r5802 r5835 24 24 PRIVATE 25 25 26 PUBLIC glob_sum ! used in many places27 PUBLIC glob_sum_full ! used in many places28 PUBLIC DDPDD ! also used in closea module26 PUBLIC glob_sum ! used in many places (masked with tmask_i) 27 PUBLIC glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos) 28 PUBLIC DDPDD ! also used in closea module 29 29 PUBLIC glob_min, glob_max 30 30 #if defined key_nosignedzero … … 360 360 FUNCTION glob_sum_full_2d( ptab ) 361 361 !!---------------------------------------------------------------------- 362 !! *** FUNCTION glob_sum_ 2d ***362 !! *** FUNCTION glob_sum_full_2d *** 363 363 !! 364 364 !! ** Purpose : perform a sum in calling DDPDD routine 365 365 !!---------------------------------------------------------------------- 366 366 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 367 REAL(wp) :: glob_sum_full_2d ! global masked sum367 REAL(wp) :: glob_sum_full_2d ! global sum (nomask) 368 368 !! 369 369 COMPLEX(wp):: ctmp … … 387 387 FUNCTION glob_sum_full_3d( ptab ) 388 388 !!---------------------------------------------------------------------- 389 !! *** FUNCTION glob_sum_ 3d ***389 !! *** FUNCTION glob_sum_full_3d *** 390 390 !! 391 391 !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 392 392 !!---------------------------------------------------------------------- 393 393 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 394 REAL(wp) :: glob_sum_full_3d ! global masked sum394 REAL(wp) :: glob_sum_full_3d ! global sum (nomask) 395 395 !! 396 396 COMPLEX(wp):: ctmp
Note: See TracChangeset
for help on using the changeset viewer.