diff --git a/horiz_interp/horiz_interp_bicubic.F90 b/horiz_interp/horiz_interp_bicubic.F90 index f640f2aa6..b57fad23c 100644 --- a/horiz_interp/horiz_interp_bicubic.F90 +++ b/horiz_interp/horiz_interp_bicubic.F90 @@ -736,13 +736,13 @@ subroutine horiz_interp_bicubic_del( Interp ) type (horiz_interp_type), intent(inout) :: Interp - if(associated(Interp%rat_x)) deallocate ( Interp%rat_x ) - if(associated(Interp%rat_y)) deallocate ( Interp%rat_y ) - if(associated(Interp%lon_in)) deallocate ( Interp%lon_in ) - if(associated(Interp%lat_in)) deallocate ( Interp%lat_in ) - if(associated(Interp%i_lon)) deallocate ( Interp%i_lon ) - if(associated(Interp%j_lat)) deallocate ( Interp%j_lat ) - if(associated(Interp%wti)) deallocate ( Interp%wti ) + if(allocated(Interp%rat_x)) deallocate ( Interp%rat_x ) + if(allocated(Interp%rat_y)) deallocate ( Interp%rat_y ) + if(allocated(Interp%lon_in)) deallocate ( Interp%lon_in ) + if(allocated(Interp%lat_in)) deallocate ( Interp%lat_in ) + if(allocated(Interp%i_lon)) deallocate ( Interp%i_lon ) + if(allocated(Interp%j_lat)) deallocate ( Interp%j_lat ) + if(allocated(Interp%wti)) deallocate ( Interp%wti ) end subroutine horiz_interp_bicubic_del diff --git a/horiz_interp/horiz_interp_bilinear.F90 b/horiz_interp/horiz_interp_bilinear.F90 index 2fe244cab..126b46087 100644 --- a/horiz_interp/horiz_interp_bilinear.F90 +++ b/horiz_interp/horiz_interp_bilinear.F90 @@ -1240,10 +1240,10 @@ subroutine horiz_interp_bilinear_del( Interp ) !! have allocated arrays. The returned variable will contain !! deallocated arrays - if(associated(Interp%wti)) deallocate(Interp%wti) - if(associated(Interp%wtj)) deallocate(Interp%wtj) - if(associated(Interp%i_lon)) deallocate(Interp%i_lon) - if(associated(Interp%j_lat)) deallocate(Interp%j_lat) + if(allocated(Interp%wti)) deallocate(Interp%wti) + if(allocated(Interp%wtj)) deallocate(Interp%wtj) + if(allocated(Interp%i_lon)) deallocate(Interp%i_lon) + if(allocated(Interp%j_lat)) deallocate(Interp%j_lat) end subroutine horiz_interp_bilinear_del diff --git a/horiz_interp/horiz_interp_conserve.F90 b/horiz_interp/horiz_interp_conserve.F90 index c09bc70e8..1f7306299 100644 --- a/horiz_interp/horiz_interp_conserve.F90 +++ b/horiz_interp/horiz_interp_conserve.F90 @@ -821,7 +821,7 @@ subroutine horiz_interp_conserve_version1 ( Interp, data_in, data_out, verbose, if (present(mask_in)) then call data_sum ( data_in(is:ie,js:je), Interp%area_src(is:ie,js:je), & fis, fie, fjs,fje, dwtsum, wtsum, arsum, mask_in(is:ie,js:je) ) - else if( ASSOCIATED(Interp%mask_in) ) then + else if( allocated(Interp%mask_in) ) then call data_sum ( data_in(is:ie,js:je), Interp%area_src(is:ie,js:je), & fis, fie, fjs,fje, dwtsum, wtsum, arsum, Interp%mask_in(is:ie,js:je) ) else @@ -924,18 +924,18 @@ subroutine horiz_interp_conserve_del ( Interp ) select case(Interp%version) case (1) - if(associated(Interp%area_src)) deallocate(Interp%area_src) - if(associated(Interp%area_dst)) deallocate(Interp%area_dst) - if(associated(Interp%facj)) deallocate(Interp%facj) - if(associated(Interp%jlat)) deallocate(Interp%jlat) - if(associated(Interp%faci)) deallocate(Interp%faci) - if(associated(Interp%ilon)) deallocate(Interp%ilon) + if(allocated(Interp%area_src)) deallocate(Interp%area_src) + if(allocated(Interp%area_dst)) deallocate(Interp%area_dst) + if(allocated(Interp%facj)) deallocate(Interp%facj) + if(allocated(Interp%jlat)) deallocate(Interp%jlat) + if(allocated(Interp%faci)) deallocate(Interp%faci) + if(allocated(Interp%ilon)) deallocate(Interp%ilon) case (2) - if(associated(Interp%i_src)) deallocate(Interp%i_src) - if(associated(Interp%j_src)) deallocate(Interp%j_src) - if(associated(Interp%i_dst)) deallocate(Interp%i_dst) - if(associated(Interp%j_dst)) deallocate(Interp%j_dst) - if(associated(Interp%area_frac_dst)) deallocate(Interp%area_frac_dst) + if(allocated(Interp%i_src)) deallocate(Interp%i_src) + if(allocated(Interp%j_src)) deallocate(Interp%j_src) + if(allocated(Interp%i_dst)) deallocate(Interp%i_dst) + if(allocated(Interp%j_dst)) deallocate(Interp%j_dst) + if(allocated(Interp%area_frac_dst)) deallocate(Interp%area_frac_dst) end select end subroutine horiz_interp_conserve_del diff --git a/horiz_interp/horiz_interp_spherical.F90 b/horiz_interp/horiz_interp_spherical.F90 index 867e24650..8a00ea9b7 100644 --- a/horiz_interp/horiz_interp_spherical.F90 +++ b/horiz_interp/horiz_interp_spherical.F90 @@ -208,7 +208,7 @@ subroutine horiz_interp_spherical_new(Interp, lon_in,lat_in,lon_out,lat_out, & endif ! allocate memory to data type - if(ASSOCIATED(Interp%i_lon)) then + if(allocated(Interp%i_lon)) then if(size(Interp%i_lon,1) .NE. map_dst_xsize .OR. & size(Interp%i_lon,2) .NE. map_dst_ysize ) call mpp_error(FATAL, & 'horiz_interp_spherical_mod: size(Interp%i_lon(:),1) .NE. map_dst_xsize .OR. '// & @@ -503,10 +503,10 @@ subroutine horiz_interp_spherical_del( Interp ) !! must have allocated arrays. The returned variable will !! contain deallocated arrays. - if(associated(Interp%src_dist)) deallocate(Interp%src_dist) - if(associated(Interp%num_found)) deallocate(Interp%num_found) - if(associated(Interp%i_lon)) deallocate(Interp%i_lon) - if(associated(Interp%j_lat)) deallocate(Interp%j_lat) + if(allocated(Interp%src_dist)) deallocate(Interp%src_dist) + if(allocated(Interp%num_found)) deallocate(Interp%num_found) + if(allocated(Interp%i_lon)) deallocate(Interp%i_lon) + if(allocated(Interp%j_lat)) deallocate(Interp%j_lat) end subroutine horiz_interp_spherical_del diff --git a/horiz_interp/horiz_interp_type.F90 b/horiz_interp/horiz_interp_type.F90 index ebcbdeecb..634244a2f 100644 --- a/horiz_interp/horiz_interp_type.F90 +++ b/horiz_interp/horiz_interp_type.F90 @@ -53,26 +53,26 @@ module horiz_interp_type_mod ! !> @ingroup horiz_interp_type_mod type horiz_interp_type - real, dimension(:,:), pointer :: faci =>NULL() !< weights for conservative scheme - real, dimension(:,:), pointer :: facj =>NULL() !< weights for conservative scheme - integer, dimension(:,:), pointer :: ilon =>NULL() !< indices for conservative scheme - integer, dimension(:,:), pointer :: jlat =>NULL() !< indices for conservative scheme - real, dimension(:,:), pointer :: area_src =>NULL() !< area of the source grid - real, dimension(:,:), pointer :: area_dst =>NULL() !< area of the destination grid - real, dimension(:,:,:), pointer :: wti =>NULL() !< weights for bilinear interpolation + real, dimension(:,:), allocatable :: faci !< weights for conservative scheme + real, dimension(:,:), allocatable :: facj !< weights for conservative scheme + integer, dimension(:,:), allocatable :: ilon !< indices for conservative scheme + integer, dimension(:,:), allocatable :: jlat !< indices for conservative scheme + real, dimension(:,:), allocatable :: area_src !< area of the source grid + real, dimension(:,:), allocatable :: area_dst !< area of the destination grid + real, dimension(:,:,:), allocatable :: wti !< weights for bilinear interpolation !! wti ist used for derivative "weights" in bicubic - real, dimension(:,:,:), pointer :: wtj =>NULL() !< weights for bilinear interpolation + real, dimension(:,:,:), allocatable :: wtj !< weights for bilinear interpolation !! wti ist used for derivative "weights" in bicubic - integer, dimension(:,:,:), pointer :: i_lon =>NULL() !< indices for bilinear interpolation + integer, dimension(:,:,:), allocatable :: i_lon !< indices for bilinear interpolation !! and spherical regrid - integer, dimension(:,:,:), pointer :: j_lat =>NULL() !< indices for bilinear interpolation + integer, dimension(:,:,:), allocatable :: j_lat !< indices for bilinear interpolation !! and spherical regrid - real, dimension(:,:,:), pointer :: src_dist =>NULL() !< distance between destination grid and + real, dimension(:,:,:), allocatable :: src_dist !< distance between destination grid and !! neighbor source grid. - logical, dimension(:,:), pointer :: found_neighbors =>NULL() !< indicate whether destination grid + logical, dimension(:,:), allocatable :: found_neighbors !< indicate whether destination grid !! has some source grid around it. real :: max_src_dist - integer, dimension(:,:), pointer :: num_found => NULL() + integer, dimension(:,:), allocatable :: num_found integer :: nlon_src !< size of source grid integer :: nlat_src !< size of source grid integer :: nlon_dst !< size of destination grid @@ -82,26 +82,26 @@ module horiz_interp_type_mod !! =2, bilinear interpolation !! =3, spherical regrid !! =4, bicubic regrid - real, dimension(:,:), pointer :: rat_x =>NULL() !< the ratio of coordinates of the dest grid + real, dimension(:,:), allocatable :: rat_x !< the ratio of coordinates of the dest grid !! (x_dest -x_src_r)/(x_src_l -x_src_r) !! and (y_dest -y_src_r)/(y_src_l -y_src_r) - real, dimension(:,:), pointer :: rat_y =>NULL() !< the ratio of coordinates of the dest grid + real, dimension(:,:), allocatable :: rat_y !< the ratio of coordinates of the dest grid !! (x_dest -x_src_r)/(x_src_l -x_src_r) !! and (y_dest -y_src_r)/(y_src_l -y_src_r) - real, dimension(:), pointer :: lon_in =>NULL() !< the coordinates of the source grid - real, dimension(:), pointer :: lat_in =>NULL() !< the coordinates of the source grid + real, dimension(:), allocatable :: lon_in !< the coordinates of the source grid + real, dimension(:), allocatable :: lat_in !< the coordinates of the source grid logical :: I_am_initialized=.false. integer :: version !< indicate conservative !! interpolation version with value 1 or 2 !--- The following are for conservative interpolation scheme version 2 ( through xgrid) integer :: nxgrid !< number of exchange grid !! between src and dst grid. - integer, dimension(:), pointer :: i_src=>NULL() !< indices in source grid. - integer, dimension(:), pointer :: j_src=>NULL() !< indices in source grid. - integer, dimension(:), pointer :: i_dst=>NULL() !< indices in destination grid. - integer, dimension(:), pointer :: j_dst=>NULL() !< indices in destination grid. - real, dimension(:), pointer :: area_frac_dst=>NULL() !< area fraction in destination grid. - real, dimension(:,:), pointer :: mask_in=>NULL() + integer, dimension(:), allocatable :: i_src !< indices in source grid. + integer, dimension(:), allocatable :: j_src !< indices in source grid. + integer, dimension(:), allocatable :: i_dst !< indices in destination grid. + integer, dimension(:), allocatable :: j_dst !< indices in destination grid. + real, dimension(:), allocatable :: area_frac_dst !< area fraction in destination grid. + real, dimension(:,:), allocatable :: mask_in end type ! @@ -181,43 +181,44 @@ subroutine stats ( dat, low, high, avg, miss, missing_value, mask ) end subroutine stats !###################################################################################################################### +!> @brief horiz_interp_type_eq creates a copy of the horiz_interp_type object subroutine horiz_interp_type_eq(horiz_interp_out, horiz_interp_in) - type(horiz_interp_type), intent(inout) :: horiz_interp_out - type(horiz_interp_type), intent(in) :: horiz_interp_in + type(horiz_interp_type), intent(inout) :: horiz_interp_out !< Output object being set + type(horiz_interp_type), intent(in) :: horiz_interp_in !< Input object being copied if(.not.horiz_interp_in%I_am_initialized) then call mpp_error(FATAL,'horiz_interp_type_eq: horiz_interp_type variable on right hand side is unassigned') endif - horiz_interp_out%faci => horiz_interp_in%faci - horiz_interp_out%facj => horiz_interp_in%facj - horiz_interp_out%ilon => horiz_interp_in%ilon - horiz_interp_out%jlat => horiz_interp_in%jlat - horiz_interp_out%area_src => horiz_interp_in%area_src - horiz_interp_out%area_dst => horiz_interp_in%area_dst - horiz_interp_out%wti => horiz_interp_in%wti - horiz_interp_out%wtj => horiz_interp_in%wtj - horiz_interp_out%i_lon => horiz_interp_in%i_lon - horiz_interp_out%j_lat => horiz_interp_in%j_lat - horiz_interp_out%src_dist => horiz_interp_in%src_dist - horiz_interp_out%found_neighbors => horiz_interp_in%found_neighbors + horiz_interp_out%faci = horiz_interp_in%faci + horiz_interp_out%facj = horiz_interp_in%facj + horiz_interp_out%ilon = horiz_interp_in%ilon + horiz_interp_out%jlat = horiz_interp_in%jlat + horiz_interp_out%area_src = horiz_interp_in%area_src + horiz_interp_out%area_dst = horiz_interp_in%area_dst + horiz_interp_out%wti = horiz_interp_in%wti + horiz_interp_out%wtj = horiz_interp_in%wtj + horiz_interp_out%i_lon = horiz_interp_in%i_lon + horiz_interp_out%j_lat = horiz_interp_in%j_lat + horiz_interp_out%src_dist = horiz_interp_in%src_dist + if (allocated(horiz_interp_in%found_neighbors)) horiz_interp_out%found_neighbors = horiz_interp_in%found_neighbors horiz_interp_out%max_src_dist = horiz_interp_in%max_src_dist - horiz_interp_out%num_found => horiz_interp_in%num_found + horiz_interp_out%num_found = horiz_interp_in%num_found horiz_interp_out%nlon_src = horiz_interp_in%nlon_src horiz_interp_out%nlat_src = horiz_interp_in%nlat_src horiz_interp_out%nlon_dst = horiz_interp_in%nlon_dst horiz_interp_out%nlat_dst = horiz_interp_in%nlat_dst horiz_interp_out%interp_method = horiz_interp_in%interp_method - horiz_interp_out%rat_x => horiz_interp_in%rat_x - horiz_interp_out%rat_y => horiz_interp_in%rat_y - horiz_interp_out%lon_in => horiz_interp_in%lon_in - horiz_interp_out%lat_in => horiz_interp_in%lat_in + horiz_interp_out%rat_x = horiz_interp_in%rat_x + horiz_interp_out%rat_y = horiz_interp_in%rat_y + horiz_interp_out%lon_in = horiz_interp_in%lon_in + horiz_interp_out%lat_in = horiz_interp_in%lat_in horiz_interp_out%I_am_initialized = .true. - horiz_interp_out%i_src => horiz_interp_in%i_src - horiz_interp_out%j_src => horiz_interp_in%j_src - horiz_interp_out%i_dst => horiz_interp_in%i_dst - horiz_interp_out%j_dst => horiz_interp_in%j_dst - horiz_interp_out%area_frac_dst => horiz_interp_in%area_frac_dst + horiz_interp_out%i_src = horiz_interp_in%i_src + horiz_interp_out%j_src = horiz_interp_in%j_src + horiz_interp_out%i_dst = horiz_interp_in%i_dst + horiz_interp_out%j_dst = horiz_interp_in%j_dst + horiz_interp_out%area_frac_dst = horiz_interp_in%area_frac_dst if(horiz_interp_in%interp_method == CONSERVE) then horiz_interp_out%version = horiz_interp_in%version if(horiz_interp_in%version==2) horiz_interp_out%nxgrid = horiz_interp_in%nxgrid diff --git a/interpolator/interpolator.F90 b/interpolator/interpolator.F90 index 4a5355040..843f6e7cd 100644 --- a/interpolator/interpolator.F90 +++ b/interpolator/interpolator.F90 @@ -193,14 +193,14 @@ module interpolator_mod private !Redundant data between fields !All climatology data -real, pointer :: lat(:) =>NULL() !< No description -real, pointer :: lon(:) =>NULL() !< No description -real, pointer :: latb(:) =>NULL() !< No description -real, pointer :: lonb(:) =>NULL() !< No description -real, pointer :: levs(:) =>NULL() !< No description -real, pointer :: halflevs(:) =>NULL() !< No description +real, allocatable :: lat(:) !< No description +real, allocatable :: lon(:) !< No description +real, allocatable :: latb(:) !< No description +real, allocatable :: lonb(:) !< No description +real, allocatable :: levs(:) !< No description +real, allocatable :: halflevs(:) !< No description type(horiz_interp_type) :: interph !< No description -type(time_type), pointer :: time_slice(:) =>NULL() !< An array of the times within the climatology. +type(time_type), allocatable :: time_slice(:) !< An array of the times within the climatology. type(FmsNetcdfFile_t) :: fileobj ! object that stores opened file information character(len=64) :: file_name !< Climatology filename integer :: TIME_FLAG !< Linear or seaonal interpolation? @@ -211,27 +211,27 @@ module interpolator_mod logical :: climatological_year !< Is data for year = 0000? !Field specific data for nfields -character(len=64), pointer :: field_name(:) =>NULL() !< name of this field -logical, pointer :: has_level(:) =>NULL() !< indicate if the variable has level dimension -integer, pointer :: time_init(:,:) =>NULL() !< second index is the number of time_slices being +character(len=64), allocatable :: field_name(:) !< name of this field +logical, allocatable :: has_level(:) !< indicate if the variable has level dimension +integer, allocatable :: time_init(:,:) !< second index is the number of time_slices being !! kept. 2 or ntime. -integer, pointer :: mr(:) =>NULL() !< Flag for conversion of climatology to mixing ratio. -integer, pointer :: out_of_bounds(:) =>NULL()!< Flag for when surface pressure is out of bounds. +integer, allocatable :: mr(:) !< Flag for conversion of climatology to mixing ratio. +integer, allocatable :: out_of_bounds(:) !< Flag for when surface pressure is out of bounds. !++lwh -integer, pointer :: vert_interp(:) =>NULL() !< Flag for type of vertical interpolation. +integer, allocatable :: vert_interp(:) !< Flag for type of vertical interpolation. !--lwh -real, pointer :: data(:,:,:,:,:) =>NULL() !< (nlatmod,nlonmod,nlevclim,size(time_init,2),nfields) +real, allocatable :: data(:,:,:,:,:) !< (nlatmod,nlonmod,nlevclim,size(time_init,2),nfields) -real, pointer :: pmon_pyear(:,:,:,:) =>NULL() !< No description -real, pointer :: pmon_nyear(:,:,:,:) =>NULL() !< No description -real, pointer :: nmon_nyear(:,:,:,:) =>NULL() !< No description -real, pointer :: nmon_pyear(:,:,:,:) =>NULL() !< No description +real, allocatable :: pmon_pyear(:,:,:,:) !< No description +real, allocatable :: pmon_nyear(:,:,:,:) !< No description +real, allocatable :: nmon_nyear(:,:,:,:) !< No description +real, allocatable :: nmon_pyear(:,:,:,:) !< No description !integer :: indexm, indexp, climatology -integer,dimension(:), pointer :: indexm =>NULL() !< No description -integer,dimension(:), pointer :: indexp =>NULL() !< No description -integer,dimension(:), pointer :: climatology =>NULL() !< No description +integer,dimension(:), allocatable :: indexm !< No description +integer,dimension(:), allocatable :: indexp !< No description +integer,dimension(:), allocatable :: climatology !< No description -type(time_type), pointer :: clim_times(:,:) => NULL() !< No description +type(time_type), allocatable :: clim_times(:,:) !< No description logical :: separate_time_vary_calc !< No description real :: tweight !< No description real :: tweight1 !< The time weight between the climatology years @@ -337,15 +337,15 @@ subroutine interpolate_type_eq (Out, In) type(interpolate_type), intent(inout) :: Out - if (associated(In%lat)) Out%lat => In%lat - if (associated(In%lon)) Out%lon => In%lon - if (associated(In%latb)) Out%latb => In%latb - if (associated(In%lonb)) Out%lonb => In%lonb - if (associated(In%levs)) Out%levs => In%levs - if (associated(In%halflevs)) Out%halflevs => In%halflevs + if (allocated(In%lat)) Out%lat = In%lat + if (allocated(In%lon)) Out%lon = In%lon + if (allocated(In%latb)) Out%latb = In%latb + if (allocated(In%lonb)) Out%lonb = In%lonb + if (allocated(In%levs)) Out%levs = In%levs + if (allocated(In%halflevs)) Out%halflevs = In%halflevs Out%interph = In%interph - if (associated(In%time_slice)) Out%time_slice => In%time_slice + if (allocated(In%time_slice)) Out%time_slice = In%time_slice Out%file_name = In%file_name Out%time_flag = In%time_flag Out%level_type = In%level_type @@ -355,21 +355,21 @@ subroutine interpolate_type_eq (Out, In) Out%je = In%je Out%vertical_indices = In%vertical_indices Out%climatological_year = In%climatological_year - if (associated(In%has_level )) Out%has_level => In%has_level - if (associated(In%field_name )) Out%field_name => In%field_name - if (associated(In%time_init )) Out%time_init => In%time_init - if (associated(In%mr )) Out%mr => In%mr - if (associated(In%out_of_bounds)) Out%out_of_bounds => In%out_of_bounds - if (associated(In%vert_interp )) Out%vert_interp => In%vert_interp - if (associated(In%data )) Out%data => In%data - if (associated(In%pmon_pyear )) Out%pmon_pyear => In%pmon_pyear - if (associated(In%pmon_nyear )) Out%pmon_nyear => In%pmon_nyear - if (associated(In%nmon_nyear )) Out%nmon_nyear => In%nmon_nyear - if (associated(In%nmon_pyear )) Out%nmon_pyear => In%nmon_pyear - if (associated(In%indexm )) Out%indexm => In%indexm - if (associated(In%indexp )) Out%indexp => In%indexp - if (associated(In%climatology )) Out%climatology => In%climatology - if (associated(In%clim_times )) Out%clim_times => In%clim_times + if (allocated(In%has_level )) Out%has_level = In%has_level + if (allocated(In%field_name )) Out%field_name = In%field_name + if (allocated(In%time_init )) Out%time_init = In%time_init + if (allocated(In%mr )) Out%mr = In%mr + if (allocated(In%out_of_bounds)) Out%out_of_bounds = In%out_of_bounds + if (allocated(In%vert_interp )) Out%vert_interp = In%vert_interp + if (allocated(In%data )) Out%data = In%data + if (allocated(In%pmon_pyear )) Out%pmon_pyear = In%pmon_pyear + if (allocated(In%pmon_nyear )) Out%pmon_nyear = In%pmon_nyear + if (allocated(In%nmon_nyear )) Out%nmon_nyear = In%nmon_nyear + if (allocated(In%nmon_pyear )) Out%nmon_pyear = In%nmon_pyear + if (allocated(In%indexm )) Out%indexm = In%indexm + if (allocated(In%indexp )) Out%indexp = In%indexp + if (allocated(In%climatology )) Out%climatology = In%climatology + if (allocated(In%clim_times )) Out%clim_times = In%clim_times Out%separate_time_vary_calc = In%separate_time_vary_calc Out%tweight = In%tweight Out%tweight1 = In%tweight1 @@ -1426,7 +1426,7 @@ subroutine init_clim_diag(clim_type, mod_axes, init_time) integer :: domain_layout(2), iscomp, iecomp,jscomp,jecomp -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "init_clim_diag : You must call interpolator_init before calling init_clim_diag") @@ -1823,7 +1823,7 @@ subroutine interpolator_4D(clim_type, Time, phalf, interp_data, & integer :: i, j, k, n character(len=256) :: err_msg -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_4D : You must call interpolator_init before calling interpolator") do n=2,size(clim_type%field_name(:)) @@ -2287,7 +2287,7 @@ subroutine interpolator_3D(clim_type, Time, phalf, interp_data,field_name, is,js -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_3D : You must call interpolator_init before calling interpolator") istart = 1 @@ -2701,7 +2701,7 @@ subroutine interpolator_2D(clim_type, Time, interp_data, field_name, is, js, cli integer :: j, i, n character(len=256) :: err_msg -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_2D : You must call interpolator_init before calling interpolator") istart = 1 @@ -3065,7 +3065,7 @@ subroutine interpolator_4D_no_time_axis(clim_type, phalf, interp_data, field_nam logical :: found_field=.false. integer :: i, j, k, n -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_4D_no_time_axis : You must call interpolator_init before calling interpolator") do n=2,size(clim_type%field_name(:)) @@ -3229,7 +3229,7 @@ subroutine interpolator_3D_no_time_axis(clim_type, phalf, interp_data, field_nam logical :: found_field=.false. !< No description integer :: i, j, k !< No description -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_3D_no_time_axis : You must call interpolator_init before calling interpolator") istart = 1 @@ -3355,7 +3355,7 @@ subroutine interpolator_2D_no_time_axis(clim_type, interp_data, field_name, is, logical :: found_field=.false. integer :: i -if (.not. module_is_initialized .or. .not. associated(clim_type%lon)) & +if (.not. module_is_initialized .or. .not. allocated(clim_type%lon)) & call mpp_error(FATAL, "interpolator_2D_no_time_axis : You must call interpolator_init before calling interpolator") istart = 1 @@ -3411,22 +3411,22 @@ subroutine interpolator_end(clim_type) write (logunit,'(/,(a))') 'Exiting interpolator, have a nice day ...' end if -if (associated (clim_type%lat )) deallocate(clim_type%lat) -if (associated (clim_type%lon )) deallocate(clim_type%lon) -if (associated (clim_type%latb )) deallocate(clim_type%latb) -if (associated (clim_type%lonb )) deallocate(clim_type%lonb) -if (associated (clim_type%levs )) deallocate(clim_type%levs) -if (associated (clim_type%halflevs)) deallocate(clim_type%halflevs) +if (allocated (clim_type%lat )) deallocate(clim_type%lat) +if (allocated (clim_type%lon )) deallocate(clim_type%lon) +if (allocated (clim_type%latb )) deallocate(clim_type%latb) +if (allocated (clim_type%lonb )) deallocate(clim_type%lonb) +if (allocated (clim_type%levs )) deallocate(clim_type%levs) +if (allocated (clim_type%halflevs)) deallocate(clim_type%halflevs) call horiz_interp_del(clim_type%interph) -if (associated (clim_type%time_slice)) deallocate(clim_type%time_slice) -if (associated (clim_type%has_level)) deallocate(clim_type%has_level) -if (associated (clim_type%field_name)) deallocate(clim_type%field_name) -if (associated (clim_type%time_init )) deallocate(clim_type%time_init) -if (associated (clim_type%mr )) deallocate(clim_type%mr) -if (associated (clim_type%data)) then +if (allocated (clim_type%time_slice)) deallocate(clim_type%time_slice) +if (allocated (clim_type%has_level)) deallocate(clim_type%has_level) +if (allocated (clim_type%field_name)) deallocate(clim_type%field_name) +if (allocated (clim_type%time_init )) deallocate(clim_type%time_init) +if (allocated (clim_type%mr )) deallocate(clim_type%mr) +if (allocated (clim_type%data)) then deallocate(clim_type%data) endif -if (associated (clim_type%pmon_pyear)) then +if (allocated (clim_type%pmon_pyear)) then deallocate(clim_type%pmon_pyear) deallocate(clim_type%pmon_nyear) deallocate(clim_type%nmon_nyear)