diff --git a/src/CPL/CLM_cpl/module_clm_HYDRO.F b/src/CPL/CLM_cpl/module_clm_HYDRO.F index d19ca3077..1297ebbe6 100644 --- a/src/CPL/CLM_cpl/module_clm_HYDRO.F +++ b/src/CPL/CLM_cpl/module_clm_HYDRO.F @@ -210,7 +210,6 @@ subroutine clm_cpl_HYDRO() write(6,*) "end of drive ndhms" #endif - return end subroutine clm_cpl_HYDRO subroutine Toclm3d (v1d_out,nn,kk1,z1_in,ix,jx,kk2,z2,v2_in) @@ -235,7 +234,6 @@ subroutine Toclm3d (v1d_out,nn,kk1,z1_in,ix,jx,kk2,z2,v2_in) call Toclm2d(v1(:,:,k),ix,jx,v1d_out(:,k),nn) end do - return end subroutine Toclm3d subroutine Toclm2d(v1,ix,jx,v1d_out,nn) @@ -266,7 +264,6 @@ subroutine Toclm2d(v1,ix,jx,v1d_out,nn) write(6,*) "after scatter_1d_r" #endif - return end subroutine Toclm2d subroutine TO1d(vg2d,v1d,nx,ny) @@ -280,7 +277,6 @@ subroutine TO1d(vg2d,v1d,nx,ny) v1d(n) = vg2d(i,j) enddo enddo - return end subroutine TO1d subroutine clm2ND3d (v1d_in,nn,kk1,z1_in,ix,jx,kk2,z2,vout) @@ -302,8 +298,6 @@ subroutine clm2ND3d (v1d_in,nn,kk1,z1_in,ix,jx,kk2,z2,vout) end do call Interp3D (z1(1:kk1),v1,kk1,z2(1:kk2),vout,ix,jx,kk2) - - return end subroutine clm2ND3d subroutine clm2ND2d (v1d_in,nn,vout,ix,jx) @@ -346,7 +340,6 @@ subroutine clm2ND2d (v1d_in,nn,vout,ix,jx) ! domain decomposition call decompose_data_real(v2d_g,vout) - return end subroutine clm2ND2d subroutine Interp3D (z1,v1,kk1,z,vout,ix,jx,kk) @@ -366,8 +359,8 @@ subroutine Interp3D (z1,v1,kk1,z,vout,ix,jx,kk) do j = 1, jx do i = 1, ix do k = 1, kk -! call interpLayer(abs(Z1),v1(i,j,1:kk1),kk1,abs( Z(k) ),vout(i,j,k)) - call interpLayer(Z1(1:kk1),v1(i,j,1:kk1),kk1,Z(k),vout(i,j,k)) +! call interpLayer(abs(Z1),v1(i,j,1:kk1),kk1,abs( Z(k) ),vout(i,j,k)) + call interpLayer(Z1(1:kk1),v1(i,j,1:kk1),kk1,Z(k),vout(i,j,k)) end do end do end do @@ -408,7 +401,7 @@ subroutine interpLayer(inZ,inV,inK,outZ,outV) if(inZ(k1) .eq. inZ(k2)) then write(6,*) "FATAL ERROR: inZ(k1)=inZ(k2) ", inZ(k1),inZ(k2) !stop 99 - stop("FATAL ERROR: In module_clm_HYDRO.F interpLayer()- inZ(k1)=inZ(k2)") + stop("FATAL ERROR: In module_clm_HYDRO.F interpLayer()- inZ(k1)=inZ(k2)") end if w1 = (outZ-inZ(k1))/(inZ(k2)-inZ(k1)) w2 = (inZ(k2)-outZ)/(inZ(k2)-inZ(k1)) @@ -692,7 +685,6 @@ subroutine output_nc(array,idim,jdim, var_name, file_name) iret = nf_inq_varid(ncid,var_name,varid) iret = nf_put_var_real(ncid,varid,array) iret=nf_close(ncid) - return end subroutine output_nc subroutine g2c_2d(lbc, ubc, lbl, ubl, lbg, ubg, num2d, carr, garr, & @@ -995,7 +987,7 @@ subroutine g2c_2d_tmp(lbc, ubc, lbl, ubl, lbg, ubg, num2d, carr, garr, & !w_yw = scale_c2l(c) * scale_l2g(l) * wtgcell(c) w_yw = scale_c2l(c) * scale_l2g(l) if(w_yw .ne. 0) then - if(abs(garr(g,j)) .gt. minv .and. abs(garr(g,j)) .lt. maxv) then + if(abs(garr(g,j)) .gt. minv .and. abs(garr(g,j)) .lt. maxv) then ! carr(c,j) = garr(g,j) / w_yw *sumwt(g) yw_r = garr(g,j) / w_yw if(yw_r .gt. 0) then diff --git a/src/CPL/Noah_cpl/module_hrldas_HYDRO.F b/src/CPL/Noah_cpl/module_hrldas_HYDRO.F index a0c717cc4..2d48aeeb5 100644 --- a/src/CPL/Noah_cpl/module_hrldas_HYDRO.F +++ b/src/CPL/Noah_cpl/module_hrldas_HYDRO.F @@ -133,8 +133,6 @@ subroutine hrldas_cpl_HYDRO(STC,SMC,SH2OX,infxsrt,sfcheadrt,soldrain,ii,jj,kk, q !? not sure for the following ! grid%xice(its:ite,jts:jte) = rt_domain(did)%sice - - return end subroutine hrldas_cpl_HYDRO subroutine hrldas_cpl_HYDRO_ini(STC,SMC,SH2OX,infxsrt,sfcheadrt,soldrain,ii,jj,kk,kt,dt, olddate,zsoil) @@ -234,7 +232,6 @@ subroutine hrldas_cpl_HYDRO_ini(STC,SMC,SH2OX,infxsrt,sfcheadrt,soldrain,ii,jj,k #endif endif - return end subroutine hrldas_cpl_HYDRO_ini subroutine open_print_mpp(iunit) diff --git a/src/Data_Rec/module_namelist.F b/src/Data_Rec/module_namelist.F index e61f5e1c9..c72a4275d 100644 --- a/src/Data_Rec/module_namelist.F +++ b/src/Data_Rec/module_namelist.F @@ -554,7 +554,6 @@ subroutine read_rt_nlst(nlst) if(channel_option .eq. 4) nlst%rtFlag = 0 ! if(CHANRTSWCRT .eq. 0 .and. SUBRTSWCRT .eq. 0 .and. OVRTSWCRT .eq. 0 .and. GWBASESWCRT .eq. 0) nlst%rtFlag = 0 if(SUBRTSWCRT .eq. 0 .and. OVRTSWCRT .eq. 0 .and. GWBASESWCRT .eq. 0) nlst%rtFlag = 0 - return end subroutine read_rt_nlst subroutine rt_nlst_check(nlst) diff --git a/src/Land_models/Noah/HRLDAS_COLLECT_DATA/lib/module_grib1.F b/src/Land_models/Noah/HRLDAS_COLLECT_DATA/lib/module_grib1.F index 2d51b7612..5c5231d3e 100644 --- a/src/Land_models/Noah/HRLDAS_COLLECT_DATA/lib/module_grib1.F +++ b/src/Land_models/Noah/HRLDAS_COLLECT_DATA/lib/module_grib1.F @@ -30,7 +30,6 @@ subroutine grib1_parameter_text_information(sec1, name, units, description) name = trim(grib1_parameter_table(sec1%parameter)%abbr) units = trim(grib1_parameter_table(sec1%parameter)%units) description = trim(grib1_parameter_table(sec1%parameter)%name) - return end subroutine grib1_parameter_text_information @@ -353,7 +352,6 @@ subroutine grib1_unpack_sec1(buffer, buffsize, iskip, sec1) write(sec1%hdate, '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)') & sec1%year, sec1%month, sec1%day, sec1%hour, sec1%minute, 00 - return end subroutine grib1_unpack_sec1 !================================================================================= @@ -609,7 +607,7 @@ end subroutine grib1_unpack_sec4 subroutine grib1_unpack_sec5(buffer, buffsize, iskip) implicit none - ! Real simple. Just check for the "7777" flag which marks the end of the + ! Real simple. Just check for the "7777" flag which marks the end of the ! GRIB1 record. integer, intent(in) :: buffsize character(len=1), dimension(buffsize), intent(in) :: buffer @@ -888,7 +886,7 @@ subroutine GRIB1_SGUP_BITMAP(grib, array, bitmap, nx, ny) -! Unpack the data according to packing parameters DFAC, BFAC, and XEC4(1), +! Unpack the data according to packing parameters DFAC, BFAC, and XEC4(1), ! and masked by the bitmap BITMAP. nn = 0 do i = 1, ndat diff --git a/src/Land_models/NoahMP/HRLDAS_forcing/lib/module_grib1.F b/src/Land_models/NoahMP/HRLDAS_forcing/lib/module_grib1.F index bbfaa5f83..f6d677dc0 100644 --- a/src/Land_models/NoahMP/HRLDAS_forcing/lib/module_grib1.F +++ b/src/Land_models/NoahMP/HRLDAS_forcing/lib/module_grib1.F @@ -27,7 +27,6 @@ subroutine grib1_parameter_text_information(sec1, name, units, description) name = trim(grib1_parameter_table(sec1%parameter)%abbr) units = trim(grib1_parameter_table(sec1%parameter)%units) description = trim(grib1_parameter_table(sec1%parameter)%name) - return end subroutine grib1_parameter_text_information @@ -350,7 +349,6 @@ subroutine grib1_unpack_sec1(buffer, buffsize, iskip, sec1) write(sec1%hdate, '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)') & sec1%year, sec1%month, sec1%day, sec1%hour, sec1%minute, 00 - return end subroutine grib1_unpack_sec1 !================================================================================= @@ -612,7 +610,7 @@ end subroutine grib1_unpack_sec4 subroutine grib1_unpack_sec5(buffer, buffsize, iskip) implicit none - ! Real simple. Just check for the "7777" flag which marks the end of the + ! Real simple. Just check for the "7777" flag which marks the end of the ! GRIB1 record. integer, intent(in) :: buffsize character(len=1), dimension(buffsize), intent(in) :: buffer @@ -891,7 +889,7 @@ subroutine GRIB1_SGUP_BITMAP(grib, array, bitmap, nx, ny) -! Unpack the data according to packing parameters DFAC, BFAC, and XEC4(1), +! Unpack the data according to packing parameters DFAC, BFAC, and XEC4(1), ! and masked by the bitmap BITMAP. nn = 0 do i = 1, ndat diff --git a/src/MPP/CPL_WRF.F b/src/MPP/CPL_WRF.F index 5d5e92e91..d7a5e0fb6 100644 --- a/src/MPP/CPL_WRF.F +++ b/src/MPP/CPL_WRF.F @@ -104,7 +104,6 @@ subroutine CPL_LAND_INIT(istart,iend,jstart,jend) p_left_right = coords(1) initialized = .false. ! land model need to be initialized. - return END subroutine CPL_LAND_INIT subroutine send_info() @@ -133,7 +132,6 @@ subroutine send_info() call MPI_barrier( HYDRO_COMM_WORLD ,ierr) - return end subroutine send_info subroutine find_left() @@ -150,7 +148,6 @@ subroutine find_left() return endif end do - return end subroutine find_left subroutine find_right() @@ -167,7 +164,6 @@ subroutine find_right() return endif end do - return end subroutine find_right subroutine find_up() @@ -184,7 +180,6 @@ subroutine find_up() return endif end do - return end subroutine find_up subroutine find_down() @@ -201,7 +196,6 @@ subroutine find_down() return endif end do - return end subroutine find_down ! stop the job due to the fatal error. @@ -212,6 +206,5 @@ subroutine fatal_error_stop(msg) call flush(error_unit) CALL MPI_Abort(HYDRO_COMM_WORLD, 1, ierr) call MPI_Finalize(ierr) - return end subroutine fatal_error_stop END MODULE MODULE_CPL_LAND diff --git a/src/MPP/mpp_land.F b/src/MPP/mpp_land.F index 602247293..1c9a48e15 100644 --- a/src/MPP/mpp_land.F +++ b/src/MPP/mpp_land.F @@ -118,7 +118,6 @@ subroutine LOG_MAP2d() np_up_down = up_down_np np_left_right = left_right_np - return end subroutine log_map2d subroutine MPP_LAND_INIT(in_global_nx,in_global_ny) @@ -148,7 +147,6 @@ subroutine MPP_LAND_INIT(in_global_nx,in_global_ny) ! create 2d logical mapping of the CPU. call log_map2d() - return end subroutine MPP_LAND_INIT @@ -213,7 +211,6 @@ subroutine MPP_LAND_PAR_INI(over_lap,in_global_nx,in_global_ny,AGGFACTRT) write(6,*) "my_id=",my_id,"global_nx=",global_nx write(6,*) "my_id=",my_id,"global_nx=",global_ny #endif - return end subroutine MPP_LAND_PAR_INI subroutine MPP_LAND_LR_COM(in_out_data,NX,NY,flag) @@ -281,7 +278,6 @@ subroutine MPP_LAND_LR_COM(in_out_data,NX,NY,flag) endif endif ! end if black for flag. - return end subroutine MPP_LAND_LR_COM subroutine MPP_LAND_LR_COM8(in_out_data,NX,NY,flag) @@ -349,7 +345,6 @@ subroutine MPP_LAND_LR_COM8(in_out_data,NX,NY,flag) endif endif ! end if black for flag. - return end subroutine MPP_LAND_LR_COM8 @@ -413,7 +408,6 @@ subroutine get_local_size(local_nx, local_ny,rt_nx,rt_ny) tag,HYDRO_COMM_WORLD,ierr) end if - return end subroutine get_local_size @@ -483,7 +477,6 @@ subroutine MPP_LAND_UB_COM(in_out_data,NX,NY,flag) up_id,tag,HYDRO_COMM_WORLD,mpp_status,ierr) endif endif ! end of block flag - return end subroutine MPP_LAND_UB_COM subroutine MPP_LAND_UB_COM8(in_out_data,NX,NY,flag) @@ -552,7 +545,6 @@ subroutine MPP_LAND_UB_COM8(in_out_data,NX,NY,flag) up_id,tag,HYDRO_COMM_WORLD,mpp_status,ierr) endif endif ! end of block flag - return end subroutine MPP_LAND_UB_COM8 subroutine calculate_start_p() @@ -623,7 +615,6 @@ subroutine calculate_start_p() local_endx_rt = local_startx_rt + local_rt_nx -1 local_endy_rt = local_starty_rt + local_rt_ny -1 - return end subroutine calculate_start_p subroutine calculate_offset_vectors() @@ -652,7 +643,6 @@ subroutine calculate_offset_vectors() last_offset = last_offset + size_vectors_rt(i) end do - return end subroutine calculate_offset_vectors subroutine decompose_data_real3d (in_buff,out_buff,klevel) @@ -717,7 +707,6 @@ subroutine decompose_data_real (in_buff,out_buff) out_buff, local_nx*local_ny, MPI_REAL, IO_id, HYDRO_COMM_WORLD, ierr) end if - return end subroutine decompose_data_real @@ -749,7 +738,6 @@ subroutine decompose_data_int (in_buff,out_buff) call mpi_recv(out_buff,size,MPI_INTEGER,IO_id, & tag,HYDRO_COMM_WORLD,mpp_status,ierr) end if - return end subroutine decompose_data_int subroutine write_IO_int(in_buff,out_buff) @@ -778,7 +766,6 @@ subroutine write_IO_int(in_buff,out_buff) end if end do end if - return end subroutine write_IO_int subroutine write_IO_char_head(in, out, imageHead) @@ -857,7 +844,6 @@ subroutine write_IO_real(in_buff,out_buff) end if end do end if - return end subroutine write_IO_real ! subroutine write_IO_RT_real_prev(in_buff,out_buff) @@ -888,7 +874,6 @@ end subroutine write_IO_real ! end if ! end do ! end if -! return ! end subroutine write_IO_RT_real_prev subroutine write_IO_RT_real (in_buff,out_buff) @@ -938,7 +923,6 @@ subroutine write_IO_RT_real (in_buff,out_buff) recv_buff, size_vectors_rt, offset_vectors_rt, MPI_REAL, & IO_id, HYDRO_COMM_WORLD, ierr) end if - return end subroutine write_IO_RT_real subroutine write_IO_RT_int (in_buff,out_buff) @@ -988,7 +972,6 @@ subroutine write_IO_RT_int (in_buff,out_buff) recv_buff, size_vectors_rt, offset_vectors_rt, MPI_INTEGER, & IO_id, HYDRO_COMM_WORLD, ierr) end if - return end subroutine write_IO_RT_int ! subroutine write_IO_RT_int (in_buff,out_buff) @@ -1020,7 +1003,6 @@ end subroutine write_IO_RT_int ! end if ! end do ! end if -! return ! end subroutine write_IO_RT_int subroutine write_IO_RT_int8(in_buff,out_buff) @@ -1052,7 +1034,6 @@ subroutine write_IO_RT_int8(in_buff,out_buff) end if end do end if - return end subroutine write_IO_RT_int8 subroutine mpp_land_bcast_log1(inout) @@ -1060,7 +1041,6 @@ subroutine mpp_land_bcast_log1(inout) integer ierr call mpi_bcast(inout,1,MPI_LOGICAL, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_log1 @@ -1070,7 +1050,6 @@ subroutine mpp_land_bcast_int(size,inout) integer ierr call mpi_bcast(inout,size,MPI_INTEGER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int subroutine mpp_land_bcast_int8(size,inout) @@ -1079,7 +1058,6 @@ subroutine mpp_land_bcast_int8(size,inout) integer ierr call mpi_bcast(inout,size,MPI_INTEGER8, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int8 subroutine mpp_land_bcast_int8_1d(inout) @@ -1089,7 +1067,6 @@ subroutine mpp_land_bcast_int8_1d(inout) len = size(inout,1) call mpi_bcast(inout,len,MPI_INTEGER8, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int8_1d subroutine mpp_land_bcast_int1d(inout) @@ -1099,7 +1076,6 @@ subroutine mpp_land_bcast_int1d(inout) len = size(inout,1) call mpi_bcast(inout,len,MPI_INTEGER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int1d subroutine mpp_land_bcast_int1d_root(inout, rootId) @@ -1109,7 +1085,6 @@ subroutine mpp_land_bcast_int1d_root(inout, rootId) integer ierr len = size(inout,1) call mpi_bcast(inout,len,MPI_INTEGER,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int1d_root subroutine mpp_land_bcast_int1(inout) @@ -1117,7 +1092,6 @@ subroutine mpp_land_bcast_int1(inout) integer ierr call mpi_bcast(inout,1,MPI_INTEGER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int1 subroutine mpp_land_bcast_int1_root(inout, rootId) @@ -1125,7 +1099,6 @@ subroutine mpp_land_bcast_int1_root(inout, rootId) integer ierr integer, intent(in) :: rootId call mpi_bcast(inout,1,MPI_INTEGER,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_int1_root subroutine mpp_land_bcast_logical(inout) @@ -1133,7 +1106,6 @@ subroutine mpp_land_bcast_logical(inout) integer ierr call mpi_bcast(inout,1,MPI_LOGICAL, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_logical subroutine mpp_land_bcast_logical_root(inout, rootId) @@ -1141,7 +1113,6 @@ subroutine mpp_land_bcast_logical_root(inout, rootId) integer, intent(in) :: rootId integer ierr call mpi_bcast(inout,1,MPI_LOGICAL,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_logical_root subroutine mpp_land_bcast_real1(inout) @@ -1149,7 +1120,6 @@ subroutine mpp_land_bcast_real1(inout) integer ierr call mpi_bcast(inout,1,MPI_REAL, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real1 subroutine mpp_land_bcast_real1_double(inout) @@ -1157,7 +1127,6 @@ subroutine mpp_land_bcast_real1_double(inout) integer ierr call mpi_bcast(inout,1,MPI_REAL8, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real1_double subroutine mpp_land_bcast_real_1d(inout) @@ -1167,7 +1136,6 @@ subroutine mpp_land_bcast_real_1d(inout) len = size(inout,1) call mpi_bcast(inout,len,MPI_real, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real_1d subroutine mpp_land_bcast_real_1d_root(inout, rootId) @@ -1177,7 +1145,6 @@ subroutine mpp_land_bcast_real_1d_root(inout, rootId) integer ierr len = size(inout,1) call mpi_bcast(inout,len,MPI_real,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real_1d_root subroutine mpp_land_bcast_real8_1d(inout) @@ -1187,7 +1154,6 @@ subroutine mpp_land_bcast_real8_1d(inout) len = size(inout,1) call mpi_bcast(inout,len,MPI_double, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real8_1d subroutine mpp_land_bcast_real(size1,inout) @@ -1197,7 +1163,6 @@ subroutine mpp_land_bcast_real(size1,inout) integer ierr, len call mpi_bcast(inout,size1,MPI_real, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_real subroutine mpp_land_bcast_int2d(inout) @@ -1210,7 +1175,6 @@ subroutine mpp_land_bcast_int2d(inout) call mpi_bcast(inout(:,k),length1,MPI_INTEGER, & IO_id,HYDRO_COMM_WORLD,ierr) end do - return end subroutine mpp_land_bcast_int2d subroutine mpp_land_bcast_real2(inout) @@ -1223,7 +1187,6 @@ subroutine mpp_land_bcast_real2(inout) call mpi_bcast(inout(:,k),length1,MPI_real, & IO_id,HYDRO_COMM_WORLD,ierr) end do - return end subroutine mpp_land_bcast_real2 subroutine mpp_land_bcast_real3d(inout) @@ -1239,7 +1202,6 @@ subroutine mpp_land_bcast_real3d(inout) IO_id, HYDRO_COMM_WORLD, ierr) end do end do - return end subroutine mpp_land_bcast_real3d subroutine mpp_land_bcast_rd(size,inout) @@ -1248,7 +1210,6 @@ subroutine mpp_land_bcast_rd(size,inout) integer ierr call mpi_bcast(inout,size,MPI_REAL8, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_rd subroutine mpp_land_bcast_char(size,inout) @@ -1257,7 +1218,6 @@ subroutine mpp_land_bcast_char(size,inout) integer ierr call mpi_bcast(inout,size,MPI_CHARACTER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_char subroutine mpp_land_bcast_char_root(size,inout,rootId) @@ -1266,7 +1226,6 @@ subroutine mpp_land_bcast_char_root(size,inout,rootId) integer, intent(in) :: rootId integer ierr call mpi_bcast(inout,size,MPI_CHARACTER,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_char_root subroutine mpp_land_bcast_char1d(inout) @@ -1276,7 +1235,6 @@ subroutine mpp_land_bcast_char1d(inout) lenSize = size(inout,1)*len(inout) call mpi_bcast(inout,lenSize,MPI_CHARACTER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_char1d subroutine mpp_land_bcast_char1d_root(inout,rootId) @@ -1286,7 +1244,6 @@ subroutine mpp_land_bcast_char1d_root(inout,rootId) integer :: ierr lenSize = size(inout,1)*len(inout) call mpi_bcast(inout,lenSize,MPI_CHARACTER,rootId,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_char1d_root subroutine mpp_land_bcast_char1(inout) @@ -1296,7 +1253,6 @@ subroutine mpp_land_bcast_char1(inout) len = LEN_TRIM(inout) call mpi_bcast(inout,len,MPI_CHARACTER, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine mpp_land_bcast_char1 subroutine MPP_LAND_COM_REAL(in_out_data,NX,NY,flag) @@ -1309,7 +1265,6 @@ subroutine MPP_LAND_COM_REAL(in_out_data,NX,NY,flag) call MPP_LAND_LR_COM(in_out_data,NX,NY,flag) call MPP_LAND_UB_COM(in_out_data,NX,NY,flag) - return end subroutine MPP_LAND_COM_REAL subroutine MPP_LAND_COM_REAL8(in_out_data,NX,NY,flag) @@ -1322,7 +1277,6 @@ subroutine MPP_LAND_COM_REAL8(in_out_data,NX,NY,flag) call MPP_LAND_LR_COM8(in_out_data,NX,NY,flag) call MPP_LAND_UB_COM8(in_out_data,NX,NY,flag) - return end subroutine MPP_LAND_COM_REAL8 subroutine MPP_LAND_COM_INTEGER(data,NX,NY,flag) @@ -1338,7 +1292,6 @@ subroutine MPP_LAND_COM_INTEGER(data,NX,NY,flag) call MPP_LAND_UB_COM(in_out_data,NX,NY,flag) data = in_out_data + 0 - return end subroutine MPP_LAND_COM_INTEGER @@ -1355,7 +1308,6 @@ subroutine MPP_LAND_COM_INTEGER8(data,NX,NY,flag) call MPP_LAND_UB_COM(in_out_data,NX,NY,flag) data = in_out_data + 0 - return end subroutine MPP_LAND_COM_INTEGER8 subroutine read_restart_3(unit,nz,out) @@ -1366,7 +1318,6 @@ subroutine read_restart_3(unit,nz,out) do i = 1,nz call decompose_data_real (buf3(:,:,i),out(:,:,i)) end do - return end subroutine read_restart_3 subroutine read_restart_2(unit,out) @@ -1379,7 +1330,6 @@ subroutine read_restart_2(unit,out) if(ierr2 .ne. 0) return call decompose_data_real (buf2,out) - return end subroutine read_restart_2 subroutine read_restart_rt_2(unit,out) @@ -1393,7 +1343,6 @@ subroutine read_restart_rt_2(unit,out) call decompose_RT_real(buf2,out, & global_rt_nx,global_rt_ny,local_rt_nx,local_rt_ny) - return end subroutine read_restart_rt_2 subroutine read_restart_rt_3(unit,nz,out) @@ -1409,7 +1358,6 @@ subroutine read_restart_rt_3(unit,nz,out) call decompose_RT_real (buf3(:,:,i),out(:,:,i),& global_rt_nx,global_rt_ny,local_rt_nx,local_rt_ny) end do - return end subroutine read_restart_rt_3 subroutine write_restart_3(unit,nz,in) @@ -1420,7 +1368,6 @@ subroutine write_restart_3(unit,nz,in) call write_IO_real(in(:,:,i),buf3(:,:,i)) end do if(my_id.eq.IO_id) write(unit) buf3 - return end subroutine write_restart_3 subroutine write_restart_2(unit,in) @@ -1429,7 +1376,6 @@ subroutine write_restart_2(unit,in) in(local_nx,local_ny) call write_IO_real(in,buf2) if(my_id.eq.IO_id) write(unit) buf2 - return end subroutine write_restart_2 subroutine write_restart_rt_2(unit,in) @@ -1438,7 +1384,6 @@ subroutine write_restart_rt_2(unit,in) in(local_rt_nx,local_rt_ny) call write_IO_RT_real(in,buf2) if(my_id.eq.IO_id) write(unit) buf2 - return end subroutine write_restart_rt_2 subroutine write_restart_rt_3(unit,nz,in) @@ -1449,7 +1394,6 @@ subroutine write_restart_rt_3(unit,nz,in) call write_IO_RT_real(in(:,:,i),buf3(:,:,i)) end do if(my_id.eq.IO_id) write(unit) buf3 - return end subroutine write_restart_rt_3 subroutine decompose_RT_real (in_buff,out_buff,g_nx,g_ny,nx,ny) @@ -1485,7 +1429,6 @@ subroutine decompose_RT_real (in_buff,out_buff,g_nx,g_ny,nx,ny) call mpi_recv(out_buff,size,MPI_REAL,IO_id, & tag,HYDRO_COMM_WORLD,mpp_status,ierr) end if - return end subroutine decompose_RT_real subroutine decompose_RT_int (in_buff,out_buff,g_nx,g_ny,nx,ny) @@ -1521,7 +1464,6 @@ subroutine decompose_RT_int (in_buff,out_buff,g_nx,g_ny,nx,ny) call mpi_recv(out_buff,size,MPI_INTEGER,IO_id, & tag,HYDRO_COMM_WORLD,mpp_status,ierr) end if - return end subroutine decompose_RT_int subroutine decompose_RT_int8 (in_buff,out_buff,g_nx,g_ny,nx,ny) @@ -1557,7 +1499,6 @@ subroutine decompose_RT_int8 (in_buff,out_buff,g_nx,g_ny,nx,ny) call mpi_recv(out_buff,size,MPI_INTEGER8,IO_id, & tag,HYDRO_COMM_WORLD,mpp_status,ierr) end if - return end subroutine decompose_RT_int8 subroutine getNX_NY(nprocs,nx,ny) @@ -1585,7 +1526,6 @@ subroutine getNX_NY(nprocs,nx,ny) end if end if end do - return end subroutine getNX_NY subroutine pack_global_22(in, & @@ -1596,7 +1536,6 @@ subroutine pack_global_22(in, & do i = 1, k call write_IO_real(in(:,:,i),out(:,:,i)) enddo - return end subroutine pack_global_22 @@ -1667,13 +1606,11 @@ subroutine wrf_LAND_set_INIT(info,total_pe,AGGFACTRT) enddo call calculate_offset_vectors() - return end subroutine wrf_LAND_set_INIT subroutine getMy_global_id() integer ierr call MPI_COMM_RANK( HYDRO_COMM_WORLD, my_id, ierr ) - return end subroutine getMy_global_id subroutine MPP_CHANNEL_COM_REAL(Link_location,ix,jy,Link_V,size,flag) @@ -1877,7 +1814,6 @@ subroutine print_2(unit,in,fm) in(local_nx,local_ny) call write_IO_real(in,buf2) if(my_id.eq.IO_id) write(unit,*) buf2 - return end subroutine print_2 subroutine print_rt_2(unit,in) @@ -1886,7 +1822,6 @@ subroutine print_rt_2(unit,in) in(local_nx,local_ny) call write_IO_real(in,buf2) if(my_id.eq.IO_id) write(unit,*) buf2 - return end subroutine print_rt_2 subroutine mpp_land_max_int1(v) @@ -1911,7 +1846,6 @@ subroutine mpp_land_max_int1(v) end if call mpp_land_bcast_int1(max) v = max - return end subroutine mpp_land_max_int1 subroutine mpp_land_max_real1(v) @@ -1936,7 +1870,6 @@ subroutine mpp_land_max_real1(v) end if call mpp_land_bcast_real1(max) v = max - return end subroutine mpp_land_max_real1 subroutine mpp_same_int1(v) @@ -2276,7 +2209,6 @@ subroutine read_rst_crt_r(unit,out,size) if(ierr2 .ne. 0) return call mpi_bcast(out,size,MPI_REAL, & IO_id,HYDRO_COMM_WORLD,ierr) - return end subroutine read_rst_crt_r subroutine write_rst_crt_r(unit,cd,map_l2g,gnlinks,nlinks) @@ -2285,7 +2217,6 @@ subroutine write_rst_crt_r(unit,cd,map_l2g,gnlinks,nlinks) real g_cd (gnlinks) call write_chanel_real(cd,map_l2g,gnlinks,nlinks, g_cd) write(unit) g_cd - return end subroutine write_rst_crt_r subroutine sum_int1d(vin,nsize) @@ -2307,7 +2238,6 @@ subroutine sum_int1d(vin,nsize) tag,HYDRO_COMM_WORLD,ierr) endif call mpp_land_bcast_int1d(vin) - return end subroutine sum_int1d subroutine combine_int1d(vin,nsize, flag) @@ -2333,7 +2263,6 @@ subroutine combine_int1d(vin,nsize, flag) tag,HYDRO_COMM_WORLD,ierr) endif call mpp_land_bcast_int1d(vin) - return end subroutine combine_int1d subroutine combine_int8_1d(vin,nsize, flag) @@ -2359,7 +2288,6 @@ subroutine combine_int8_1d(vin,nsize, flag) tag,HYDRO_COMM_WORLD,ierr) endif call mpp_land_bcast_int8_1d(vin) - return end subroutine combine_int8_1d subroutine sum_real1d(vin,nsize) @@ -2393,7 +2321,6 @@ subroutine sum_real8(vin,nsize) endif call mpp_land_bcast_real(nsize,v) vin = v - return end subroutine sum_real8 ! subroutine get_globalDim(ix,g_ix) @@ -2410,7 +2337,6 @@ end subroutine sum_real8 ! endif ! call mpp_land_bcast_int1(g_ix) ! -! return ! ! end subroutine get_globalDim @@ -2457,7 +2383,6 @@ subroutine gather_1d_real_tmp(vl,s_in,e_in,vg,sg) tag,HYDRO_COMM_WORLD,ierr) end if - return end subroutine gather_1d_real_tmp subroutine sum_real1(inout) @@ -2823,7 +2748,6 @@ subroutine match1dLake(vin,nsize,flag) tag,HYDRO_COMM_WORLD,ierr) endif call mpp_land_bcast_int1d(vin) - return end subroutine match1dLake subroutine mpp_land_abort() @@ -2837,7 +2761,6 @@ subroutine mpp_land_sync() integer ierr call MPI_barrier( HYDRO_COMM_WORLD ,ierr) if(ierr .ne. 0) call mpp_land_abort() - return end subroutine mpp_land_sync ! mpp_land_sync subroutine mpp_comm_scalar_real(scalar, fromImage, toImage) diff --git a/src/Routing/Noah_distr_routing.F b/src/Routing/Noah_distr_routing.F index c92740f92..3de5c5339 100644 --- a/src/Routing/Noah_distr_routing.F +++ b/src/Routing/Noah_distr_routing.F @@ -127,7 +127,6 @@ SUBROUTINE GETMAX8DIR(IXX0,JYY0,I,J,H,RETENT_DEP,sox,tmp_gsize,max,XX,YY) IXX8 = I-1 JYY8 = J+1 call GET8DIR(IXX8,JYY8,I,J,H,RETENT_DEP,sox(:,:,8),IXX0,JYY0,max,tmp_gsize(8),XX,YY) - RETURN END SUBROUTINE GETMAX8DIR SUBROUTINE GET8DIR(IXX8,JYY8,I,J,H,RETENT_DEP,sox & @@ -187,7 +186,6 @@ SUBROUTINE GETSUB8(I, J, XX, YY, wattbl, terrslpNeighbors, distNeighbors, & terrslpNeighbors(I,J,neighIndx), distNeighbors(neighIndx), & maxneighI, maxneighJ, maxneighIndx, maxneighSlp) enddo - RETURN END SUBROUTINE GETSUB8 SUBROUTINE GETSUB8DIR(I, J, selfWattbl, & @@ -321,7 +319,6 @@ SUBROUTINE TER_ADJ_SOL(IX,JX,SO8LD_D,TSLP,SHORT,XLAT,XLONG,olddate,DT) SHORT = SOLDN - return end SUBROUTINE TER_ADJ_SOL !DJG----------------------------------------------------------------------- !DJG END SUBROUTINE TER_ADJ_SOL @@ -487,7 +484,6 @@ subroutine GMT2LOCAL(IX,JX,XLONG,YY,MM,DD,HH,MIN,DT) end do !i-loop end do !j-loop - return end subroutine !DJG----------------------------------------------------------------------- @@ -522,7 +518,6 @@ subroutine JULDAY_CALC(YYYY,MM,DD,JULDAY) JULDAY = LPJULM(MM) + DD end if - RETURN END subroutine JULDAY_CALC !DJG----------------------------------------------------------------------- !DJG END SUBROUTINE JULDAY @@ -575,7 +570,6 @@ subroutine SLOPE_ASPECT(IX,JX,SO8LD_D,TAZI) END DO END DO - RETURN END subroutine SLOPE_ASPECT !DJG----------------------------------------------------------------------- !DJG END SUBROUTINE SLOPE_ASPECT @@ -741,7 +735,6 @@ SUBROUTINE SOLSUB(LONG,LAT,AZ,IN,SC,YY,MO,IDA,IHR,MM,OUT1, & END IF ! End if for daily vs instantaneous values... !DJG----------------------------------------------------------------------- - RETURN END SUBROUTINE SOLSUB !DJG----------------------------------------------------------------------- @@ -813,7 +806,6 @@ subroutine seq_land_SO8(SO8LD_D,Vmax,TERR,dx,ix,jx) enddo enddo Vmax = TANH(Vmax) - return end subroutine seq_land_SO8 #ifdef MPP_LAND @@ -850,7 +842,6 @@ subroutine MPP_seq_land_SO8(SO8LD_D,Vmax,TERRAIN,dx,ix,jx,& endif call decompose_data_int(g_SO8LD_D(:,:,3),SO8LD_D(:,:,3)) call decompose_data_real(g_Vmax,Vmax) - return end subroutine MPP_seq_land_SO8 #endif @@ -1315,5 +1306,4 @@ subroutine time_seconds(i3) call date_and_time(values=time_array) i3 = time_array(4)*24*3600+time_array(5) * 3600 + time_array(6) * 60 + & time_array(7) + 0.001 * time_array(8) - return end subroutine time_seconds diff --git a/src/Routing/module_GW_baseflow.F b/src/Routing/module_GW_baseflow.F index 71bb1d50d..34c346a07 100644 --- a/src/Routing/module_GW_baseflow.F +++ b/src/Routing/module_GW_baseflow.F @@ -214,7 +214,7 @@ subroutine simp_gw_buck_nhd( & if (bucket_loss .eq. 1) then qloss_gwsubbas(bas) = qout_gwsubbas(bas)*loss_fraction(bas) - qout_gwsubbas(bas) = qout_gwsubbas(bas)-qloss_gwsubbas(bas) + qout_gwsubbas(bas) = qout_gwsubbas(bas)-qloss_gwsubbas(bas) endif elseif (GWBASESWCRT.eq.2) then !Pass through/steady-state bucket @@ -231,7 +231,7 @@ subroutine simp_gw_buck_nhd( & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (bucket_loss .eq. 1) then - z_gwsubbas(bas) = z_gwsubbas(bas) - (qout_gwsubbas(bas)+qloss_gwsubbas(bas))*DT/( basns_area(bas) ) ! units (meters) + z_gwsubbas(bas) = z_gwsubbas(bas) - (qout_gwsubbas(bas)+qloss_gwsubbas(bas))*DT/( basns_area(bas) ) ! units (meters) else z_gwsubbas(bas) = z_gwsubbas(bas) - (qout_gwsubbas(bas))*DT/( basns_area(bas) ) ! units (meters) endif @@ -250,7 +250,6 @@ subroutine simp_gw_buck_nhd( & z_gwsubbas_tmp(1:numbasns) = z_gwsubbas(1:numbasns) ! units (meters) - return !------------------------------------------------------------------------------ End subroutine simp_gw_buck_nhd @@ -439,7 +438,7 @@ subroutine simp_gw_buck(ix,jx,ixrt,jxrt,numbasns,gnumbasns,basns_area,basnsInd,g !DJG bug adjust output to be mm and correct area bug... / (ct_bas(bas)*basns_area(bas)) !units(m) z_gwsubbas(bas) = z_gwsubbas(bas) - qout_gwsubbas(bas)*DT/( & - ct_bas(bas)*basns_area(bas))*1000. ! units (mm) + ct_bas(bas)*basns_area(bas))*1000. ! units (mm) !DJG...Combine calculated bucket discharge and amount spilled from bucket... !ADCHANGE: Add in surface runoff as direct pass-through @@ -488,7 +487,6 @@ subroutine simp_gw_buck(ix,jx,ixrt,jxrt,numbasns,gnumbasns,basns_area,basnsInd,g z_gwsubbas = z_gwsubbas_tmp - return !------------------------------------------------------------------------------ End subroutine simp_gw_buck @@ -549,7 +547,6 @@ subroutine pix_ct_1(in_gw_strm_msk,ixrt,jxrt,gwbas_pix_ct,numbasns,gnumbasns,bas end do - return end subroutine pix_ct_1 #endif diff --git a/src/Routing/module_HYDRO_io.F b/src/Routing/module_HYDRO_io.F index 1372c86ae..f0544c299 100644 --- a/src/Routing/module_HYDRO_io.F +++ b/src/Routing/module_HYDRO_io.F @@ -674,7 +674,6 @@ subroutine get_2d_netcdf_cows(var_name,ncid,var, & endif iret = nf90_get_var(ncid, varid, var, start, count) - return end subroutine get_2d_netcdf_cows !--------------------------------------------------------- @@ -1061,7 +1060,6 @@ subroutine get_NLINKSL(NLINKSL, channel_option, route_link_f) end if !end-if is now for channel_option just above, not IF from further up - return end subroutine get_NLINKSL subroutine nreadRT2d_real(var_name, inv, ixrt, jxrt, fileName, fatalErr) @@ -1336,7 +1334,6 @@ subroutine MPP_READ_SIMP_GW(IX,JX,IXRT,JXRT,GWSUBBASMSK,gwbasmskfil,& if(allocated(g_ch_netrt)) deallocate(g_ch_netrt) if(allocated(g_GWSUBBASMSK)) deallocate(g_GWSUBBASMSK) - return end subroutine MPP_READ_SIMP_GW #endif @@ -1416,7 +1413,6 @@ subroutine READ_SIMP_GW(IX,JX,IXRT,JXRT,GWSUBBASMSK,gwbasmskfil,& write(6,*) "numbasns = ", numbasns #endif - return !DJG ----------------------------------------------------- END SUBROUTINE READ_SIMP_GW @@ -1486,7 +1482,6 @@ subroutine SIMP_GW_IND(ix,jx,GWSUBBASMSK,numbasns,gnumbasns,basnsInd) write(6,*) "check numbasns, gnumbasns : ", numbasns, gnumbasns #endif - return end subroutine SIMP_GW_IND subroutine read_GWBUCKPARM (inFile, numbasns, gnumbasns, basnsInd, & @@ -1739,7 +1734,6 @@ subroutine readGW2d(ix, jx, hc, ihead, botelv, por, ltype, ihShift) !bftodo: make filename accessible in namelist - return end subroutine readGW2d !BF @@ -4752,7 +4746,6 @@ subroutine mpp_output_lakes(lake_index,igrid, split_output_count, NLAKES, & qlakei,qlakeo, resht,dtrt_ch,K) end if call mpp_land_sync() - return end subroutine mpp_output_lakes subroutine mpp_output_lakes2(lake_index,igrid, split_output_count, NLAKES, & @@ -4787,7 +4780,6 @@ subroutine mpp_output_lakes2(lake_index,igrid, split_output_count, NLAKES, & qlakei,qlakeo, resht,dtrt_ch,K, LAKEIDM) end if call mpp_land_sync() - return end subroutine mpp_output_lakes2 #endif @@ -5254,7 +5246,6 @@ subroutine mpp_output_chrtgrd(igrid, split_output_count, ixrt,jxrt, & if(allocated(g_qlink)) deallocate(g_qlink) if(allocated(CH_NETLNK)) deallocate(CH_NETLNK) - return end subroutine mpp_output_chrtgrd #endif @@ -5480,7 +5471,6 @@ subroutine get2d_int(var_name,out_buff,ix,jx,fileName, fatalErr) if(fatalErr_local) call hydro_stop(trim(errMsg)) endif - return end subroutine get2d_int subroutine get2d_int8(var_name,out_buff,ix,jx,fileName, fatalErr) @@ -5527,7 +5517,6 @@ subroutine get2d_int8(var_name,out_buff,ix,jx,fileName, fatalErr) if(fatalErr_local) call hydro_stop(trim(errMsg)) endif - return end subroutine get2d_int8 #ifdef MPP_LAND @@ -5611,7 +5600,6 @@ SUBROUTINE MPP_READ_ROUTEDIM(did,g_IXRT,g_JXRT, GCH_NETLNK,GNLINKS,IXRT,JXRT, & end do call mpp_chrt_nlinks_collect(NLINKS) - return end SUBROUTINE MPP_READ_ROUTEDIM @@ -5708,7 +5696,6 @@ SUBROUTINE READ_ROUTING_seq(IXRT,JXRT,ELRT,CH_NETRT,CH_LNKRT,LKSATFAC,route_topo write(6,*) "finish READ_ROUTING_seq" #endif - return !DJG ----------------------------------------------------- END SUBROUTINE READ_ROUTING_seq @@ -5808,7 +5795,6 @@ subroutine output_lsm(outFile,did) endif #endif - return end subroutine output_lsm @@ -6198,7 +6184,6 @@ subroutine RESTART_OUT_nc(outFile,did) #endif iret = nf90_close(ncid) - return end subroutine RESTART_OUT_nc #ifdef MPP_LAND @@ -6405,7 +6390,6 @@ subroutine w_rst_rt_nc2(ncid,ix,jx,inVar,varName) endif #endif - return end subroutine w_rst_rt_nc2 subroutine w_rst_rt_nc3(ncid,ix,jx,NSOIL,inVar, varName) @@ -6440,7 +6424,6 @@ subroutine w_rst_rt_nc3(ncid,ix,jx,NSOIL,inVar, varName) iret = nf90_put_var(ncid, varid, inVar(:,:,k), (/1,1/), (/ix,jx/)) end do #endif - return end subroutine w_rst_rt_nc3 subroutine w_rst_nc2(ncid,ix,jx,inVar,varName) @@ -6461,7 +6444,6 @@ subroutine w_rst_nc2(ncid,ix,jx,inVar,varName) iret = nf90_put_var(ncid, varid, invar, (/1,1/), (/ix,jx/)) #endif - return end subroutine w_rst_nc2 subroutine w_rst_nc3(ncid,ix,jx,NSOIL,inVar, varName) @@ -6497,7 +6479,6 @@ subroutine w_rst_nc3(ncid,ix,jx,NSOIL,inVar, varName) iret = nf90_put_var(ncid, varid, inVar(:,:,k), (/1,1/), (/ix,jx/)) end do #endif - return end subroutine w_rst_nc3 subroutine w_rst_crt_nc1_lake(ncid,n,inVar,varName & @@ -6521,7 +6502,6 @@ subroutine w_rst_crt_nc1_lake(ncid,n,inVar,varName & #ifdef MPP_LAND endif #endif - return end subroutine w_rst_crt_nc1_lake subroutine w_rst_crt_reach_real(ncid,inVar,varName & @@ -6555,7 +6535,6 @@ subroutine w_rst_crt_reach_real(ncid,inVar,varName & iret = nf90_inq_varid(ncid,varName, varid) iret = nf90_put_var(ncid, varid, inVar, (/1/), (/n/)) #endif - return end subroutine w_rst_crt_reach_real @@ -6590,7 +6569,6 @@ subroutine w_rst_crt_reach_real8(ncid,inVar,varName & iret = nf90_inq_varid(ncid,varName, varid) iret = nf90_put_var(ncid, varid, inVar, (/1/), (/n/)) #endif - return end subroutine w_rst_crt_reach_real8 @@ -6618,7 +6596,6 @@ subroutine w_rst_crt_nc1(ncid,n,inVar,varName & #ifdef MPP_LAND endif #endif - return end subroutine w_rst_crt_nc1 subroutine w_rst_crt_nc1g(ncid,n,inVar,varName) @@ -6634,7 +6611,6 @@ subroutine w_rst_crt_nc1g(ncid,n,inVar,varName) #ifdef MPP_LAND endif #endif - return end subroutine w_rst_crt_nc1g subroutine w_rst_gwbucket_real(ncid,numbasns,gnumbasns, & @@ -6915,7 +6891,6 @@ subroutine RESTART_IN_NC(inFile,did) call flush(6) #endif -return end subroutine RESTART_IN_nc @@ -6965,7 +6940,6 @@ subroutine read_rst_nc3(ncid,ix,jx,NSOIL,var,varStr) #endif end do - return end subroutine read_rst_nc3 subroutine read_rst_nc2(ncid,ix,jx,var,varStr) @@ -7001,7 +6975,6 @@ subroutine read_rst_nc2(ncid,ix,jx,var,varStr) var = 0.0 iret = nf90_get_var(ncid, varid, var) #endif - return end subroutine read_rst_nc2 subroutine read_rst_rt_nc3(ncid,ix,jx,NSOIL,var,varStr) @@ -7043,7 +7016,6 @@ subroutine read_rst_rt_nc3(ncid,ix,jx,NSOIL,var,varStr) iret = nf90_get_var(ncid, varid, var(:,:,i)) #endif end do - return end subroutine read_rst_rt_nc3 subroutine read_rst_rt_nc2(ncid,ix,jx,var,varStr) @@ -7074,7 +7046,6 @@ subroutine read_rst_rt_nc2(ncid,ix,jx,var,varStr) #else iret = nf90_get_var(ncid, varid, var) #endif - return end subroutine read_rst_rt_nc2 subroutine read_rt_nc2(ncid,ix,jx,var,varStr) @@ -7117,7 +7088,6 @@ subroutine read_rt_nc2(ncid,ix,jx,var,varStr) #else iret = nf90_get_var(ncid, varid, var) #endif - return end subroutine read_rt_nc2 subroutine read_rst_crt_nc(ncid,var,n,varStr) @@ -7153,7 +7123,6 @@ subroutine read_rst_crt_nc(ncid,var,n,varStr) call mpp_land_bcast_real(n,var) endif #endif - return end subroutine read_rst_crt_nc subroutine read_rst_crt_stream_nc(ncid,var_out,n,varStr,gnlinks,map_l2g) @@ -7207,7 +7176,6 @@ subroutine read_rst_crt_stream_nc(ncid,var_out,n,varStr,gnlinks,map_l2g) #else var_out = var #endif - return end subroutine read_rst_crt_stream_nc subroutine read_rst_crt_reach_nc_real(ncid,var_out,varStr,gnlinksl, fatalErr) @@ -7306,7 +7274,6 @@ subroutine read_rst_crt_reach_nc_real(ncid,var_out,varStr,gnlinksl, fatalErr) if(allocated(var)) deallocate(var) #endif - return end subroutine read_rst_crt_reach_nc_real @@ -7387,7 +7354,6 @@ subroutine read_rst_crt_reach_nc_real8(ncid, var_out, varStr, gnlinksl, fatalErr iret = nf90_get_var(ncid, varid, var_out) if(allocated(var)) deallocate(var) #endif - return end subroutine read_rst_crt_reach_nc_real8 @@ -8843,7 +8809,6 @@ subroutine MPP_READ_CHROUTING_new(& link_location = CH_NETLNK -return end subroutine MPP_READ_CHROUTING_new diff --git a/src/Routing/module_UDMAP.F b/src/Routing/module_UDMAP.F index 8164c0a2c..ff621ea31 100644 --- a/src/Routing/module_UDMAP.F +++ b/src/Routing/module_UDMAP.F @@ -315,8 +315,8 @@ subroutine UDMP2LOCAL(npid,ix,jx,rtmask, ter_rt_flag) allocate(LUDRSL(LNUMRSL)) allocate( basns_area(LNUMRSL) ) else -! When MPI is performed,for every subdomain in each process, all the links -! are listed and if there is no link in the subdomain then it is calling +! When MPI is performed,for every subdomain in each process, all the links +! are listed and if there is no link in the subdomain then it is calling ! cleanBuf (memory cleaning purposes), this used to print a warning ! that is not necessary for the user to see it, therefore it is been commented out here ! write(6,*) "Warning: no routing links found." @@ -445,7 +445,6 @@ subroutine get_dimension(fileName, ndata,npid) call mpp_land_bcast_int1(ndata) call mpp_land_bcast_int1(npid) #endif - return end subroutine get_dimension subroutine get1d_real8(fileName,var_name,out_buff) @@ -524,17 +523,17 @@ subroutine getUDMP_area(cell_area) do k = 1, LNUMRSL if(LUDRSL(k)%ngrids .gt. 0) then do m = 1, LUDRSL(k)%ngrids - LUDRSL(k)%nodeArea(m) = cell_area(LUDRSL(k)%grid_i(m),LUDRSL(k)%grid_j(m)) + LUDRSL(k)%nodeArea(m) = cell_area(LUDRSL(k)%grid_i(m),LUDRSL(k)%grid_j(m)) enddo endif do m = 1, LUDRSL(k)%ncell - LUDRSL(k)%cellArea(m) = cell_area(LUDRSL(k)%cell_i(m),LUDRSL(k)%cell_j(m)) + LUDRSL(k)%cellArea(m) = cell_area(LUDRSL(k)%cell_i(m),LUDRSL(k)%cell_j(m)) enddo basns_area(k) = 0 do m = 1, LUDRSL(k)%ncell basns_area(k) = basns_area(k) + & - cell_area(LUDRSL(k)%cell_i(m),LUDRSL(k)%cell_j(m)) * LUDRSL(k)%cellWeight(m) + cell_area(LUDRSL(k)%cell_i(m),LUDRSL(k)%cell_j(m)) * LUDRSL(k)%cellWeight(m) enddo end do diff --git a/src/Routing/module_channel_routing.F b/src/Routing/module_channel_routing.F index 641d38e5e..4f202b590 100644 --- a/src/Routing/module_channel_routing.F +++ b/src/Routing/module_channel_routing.F @@ -1504,7 +1504,6 @@ subroutine check_lake(unit,cd,lake_index,nlakes) #endif write(unit,*) cd call flush(unit) - return end subroutine check_lake subroutine check_channel(unit,cd,did,nlinks) @@ -1527,7 +1526,6 @@ subroutine check_channel(unit,cd,did,nlinks) #endif call flush(unit) close(unit) - return end subroutine check_channel subroutine smoth121(var,nlinks,maxv_p,from_node,to_node) implicit none @@ -1561,7 +1559,6 @@ subroutine smoth121(var,nlinks,maxv_p,from_node,to_node) endif end do var = vartmp - return end subroutine smoth121 ! SUBROUTINE drive_CHANNEL for NHDPLUS diff --git a/src/Routing/module_gw_gw2d.F b/src/Routing/module_gw_gw2d.F index 72b58e47f..d2eb173cf 100644 --- a/src/Routing/module_gw_gw2d.F +++ b/src/Routing/module_gw_gw2d.F @@ -83,7 +83,6 @@ subroutine gw2d_ini(did,dt,dx) end do - return end subroutine gw2d_ini subroutine gw2d_allocate(did, ix, jx, nsoil) @@ -911,7 +910,6 @@ subroutine gwstep(ix, jx, dx, & ! /3x,4f9.4,2(9x),e14.4) /3x,5(e14.4)) - return end subroutine gwstep @@ -930,7 +928,6 @@ SUBROUTINE SCOPY (NT, ARR, INCA, BRR, INCB) IB = IB + INCB 10 CONTINUE ! - RETURN END SUBROUTINE SCOPY @@ -1490,7 +1487,6 @@ subroutine parysolv1(c,b,r,ct,pid,z_pid, & endif - return end subroutine @@ -1805,7 +1801,6 @@ subroutine parxsolv1(c,b,r,ct,pid,x_pid, & endif - return end subroutine @@ -2036,7 +2031,6 @@ subroutine sub_n_form(n_xs,n_zs,c,a,b,r,c2,b2,r2,wk,xfac,zfac, & ! stop endif - return end subroutine #endif @@ -2130,7 +2124,6 @@ subroutine sub_tri_solv(n_xs,n_zs,c,a,b,r,x,wk,xfac,zfac,dir) ! stop endif - return end subroutine diff --git a/src/Routing/module_lsm_forcing.F b/src/Routing/module_lsm_forcing.F index 01b4931b9..0fbf9d042 100644 --- a/src/Routing/module_lsm_forcing.F +++ b/src/Routing/module_lsm_forcing.F @@ -303,7 +303,6 @@ subroutine get_2d_netcdf_ruc(var_name,ncid,var, & ierr = nf90_get_var(ncid, varid, var, start, count) - return end subroutine get_2d_netcdf_ruc @@ -334,7 +333,6 @@ subroutine get_2d_netcdf_cows(var_name,ncid,var, & endif iret = nf90_get_var(ncid, varid, var, start,count) - return end subroutine get_2d_netcdf_cows @@ -862,7 +860,6 @@ subroutine get2d_hrldas(inflnm,ix,jx,nsoil,smc,stc,sh2ox,cmc,t1,weasd,snodep) call get2d_hrldas_real("SOIL_W_8", ncid, SH2OX(:,:,8), ix, jx) iret = nf90_close(ncid) - return end subroutine get2d_hrldas subroutine get2d_hrldas_real(var_name,ncid,out_buff,ix,jx) @@ -872,7 +869,6 @@ subroutine get2d_hrldas_real(var_name,ncid,out_buff,ix,jx) character(len=*), intent(in) :: var_name iret = nf90_inq_varid(ncid,trim(var_name), varid) iret = nf90_get_var(ncid, varid, out_buff) - return end subroutine get2d_hrldas_real subroutine read_stage4(flnm,IX,JX,pcp) @@ -897,7 +893,6 @@ subroutine read_stage4(flnm,IX,JX,pcp) end do end do pcp = buf - return END subroutine read_stage4 @@ -1675,7 +1670,6 @@ subroutine mpp_readland_hrldas(geo_static_flnm,& call decompose_data_real(g_TERRAIN,TERRAIN) call decompose_data_real(g_LATITUDE,LATITUDE) call decompose_data_real(g_LONGITUDE,LONGITUDE) - return end subroutine mpp_readland_hrldas @@ -1701,7 +1695,6 @@ subroutine MPP_READSNOW_FORC(flnm,ix,jx,OLDDATE,weasd,snodep,& call decompose_data_real(g_WEASD,WEASD) call decompose_data_real(g_SNODEP,SNODEP) - return end subroutine MPP_READSNOW_FORC subroutine MPP_DEEPGW_HRLDAS(ix,jx,in_SMCMAX,& @@ -1738,7 +1731,6 @@ subroutine MPP_DEEPGW_HRLDAS(ix,jx,in_SMCMAX,& call decompose_data_real(g_sh2ox(:,:,k),out_sh2ox(:,:,k)) end do - return end subroutine MPP_DEEPGW_HRLDAS @@ -1823,7 +1815,6 @@ subroutine read_hydro_forcing_mpp( & call decompose_data_real(g_fpar,fpar) call decompose_data_real(g_snodep,snodep) - return end subroutine read_hydro_forcing_mpp #endif