From a36287c956f922b219a179e5d0f245265626f6a2 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Fri, 29 May 2026 10:16:41 +0200 Subject: [PATCH 1/3] fix fortitude-lint version at 0.9.0 Currently newer loaded versions add more checks, which in turn make the CI-check unstable. From now on the fortitude-lint version should be updated manually after checking new rules. https://github.com/PlasmaFAIR/fortitude/releases --- .github/workflows/style-check.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/style-check.yml b/.github/workflows/style-check.yml index 0984c545..a94a71f1 100644 --- a/.github/workflows/style-check.yml +++ b/.github/workflows/style-check.yml @@ -35,7 +35,7 @@ jobs: cache: 'pip' - name: Install pip packages - run: pip install fortitude-lint + run: pip install fortitude-lint==0.9.0 #TODO: Checking only the interface, could also be interesting to use #for src/ and PR into main PDAF From 750afba1eeb389aa2d6261d6a78b17e3fb6dfc36 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Fri, 29 May 2026 10:37:19 +0200 Subject: [PATCH 2/3] fortitude: fixable rules --- interface/framework/add_obs_error_pdaf.F90 | 8 +- interface/framework/assimilate_pdaf.F90 | 12 +- interface/framework/callback_obs_pdafomi.F90 | 8 +- interface/framework/collect_state_pdaf.F90 | 2 +- interface/framework/distribute_state_pdaf.F90 | 2 +- .../framework/distribute_stateinc_pdaf.F90 | 2 +- interface/framework/g2l_state_pdaf.F90 | 2 +- interface/framework/init_dim_obs_f_pdaf.F90 | 36 +-- interface/framework/init_dim_obs_l_pdaf.F90 | 14 +- interface/framework/init_dim_obs_pdaf.F90 | 36 +-- interface/framework/init_ens.F90 | 6 +- interface/framework/init_obscovar_pdaf.F90 | 8 +- interface/framework/init_obsvar_pdaf.F90 | 10 +- interface/framework/init_parallel_pdaf.F90 | 69 ++--- interface/framework/init_pdaf.F90 | 16 +- interface/framework/init_pdaf_info.F90 | 238 +++++++++--------- interface/framework/init_pdaf_parse.F90 | 64 ++--- interface/framework/l2g_state_pdaf.F90 | 2 +- interface/framework/localize_covar_pdaf.F90 | 20 +- interface/framework/mod_parallel_pdaf.F90 | 2 +- interface/framework/mod_read_obs.F90 | 20 +- interface/framework/next_observation_pdaf.F90 | 42 ++-- interface/framework/obs_GRACE_pdafomi.F90 | 51 ++-- interface/framework/obs_SM_pdafomi.F90 | 49 ++-- interface/framework/obs_op_pdaf.F90 | 40 +-- interface/framework/parser_mpi.F90 | 70 +++--- interface/framework/pdaf_terrsysmp.F90 | 4 +- interface/framework/prepoststep_ens_pdaf.F90 | 26 +- interface/framework/prodrinva_l_pdaf.F90 | 26 +- interface/framework/prodrinva_pdaf.F90 | 2 +- interface/model/eclm/enkf_clm_5.F90 | 22 +- interface/model/eclm/enkf_clm_mod_5.F90 | 44 ++-- interface/model/eclm/print_update_clm_5.F90 | 14 +- 33 files changed, 485 insertions(+), 482 deletions(-) diff --git a/interface/framework/add_obs_error_pdaf.F90 b/interface/framework/add_obs_error_pdaf.F90 index 5020017d..067644cd 100644 --- a/interface/framework/add_obs_error_pdaf.F90 +++ b/interface/framework/add_obs_error_pdaf.F90 @@ -92,8 +92,8 @@ SUBROUTINE add_obs_error_pdaf(step, dim_obs, C_p) if(multierr/=1) then DO i = 1, dim_obs C_p(i, i) = C_p(i, i) + variance_obs - ENDDO - endif + END DO + end if if(multierr==1) then @@ -110,7 +110,7 @@ SUBROUTINE add_obs_error_pdaf(step, dim_obs, C_p) #else C_p(i,i) = C_p(i,i) + pressure_obserr(obs_pdaf2nc(i))*pressure_obserr(obs_pdaf2nc(i)) #endif - enddo - endif + end do + end if END SUBROUTINE add_obs_error_pdaf diff --git a/interface/framework/assimilate_pdaf.F90 b/interface/framework/assimilate_pdaf.F90 index 5492ef2f..3afcd201 100644 --- a/interface/framework/assimilate_pdaf.F90 +++ b/interface/framework/assimilate_pdaf.F90 @@ -153,7 +153,7 @@ SUBROUTINE assimilate_pdaf() init_dim_obs_pdafomi, obs_op_pdafomi, prepoststep_ens_pdaf, & localize_covar_pdafomi, next_observation_pdaf, status_pdaf) - ELSEIF (filtertype == 2) then ! non diagonal R for EnKF has its own callback routine + ELSE IF (filtertype == 2) then ! non diagonal R for EnKF has its own callback routine CALL PDAFomi_assimilate_enkf_nondiagR(collect_state_pdaf, distribute_state_pdaf, & init_dim_obs_pdafomi, obs_op_pdafomi, add_obs_err_pdafomi, init_obscovar_pdafomi, & prepoststep_ens_pdaf, next_observation_pdaf, status_pdaf) @@ -164,9 +164,9 @@ SUBROUTINE assimilate_pdaf() init_dim_obs_pdafomi, obs_op_pdafomi, prodRinvA_pdafomi, & prepoststep_ens_pdaf, next_observation_pdaf, status_pdaf) - ENDIF + END IF - ENDIF + END IF #endif ELSE OMI @@ -245,9 +245,9 @@ SUBROUTINE assimilate_pdaf() ! Check for errors during execution of PDAF IF (status_pdaf /= 0) THEN - WRITE (*,'(/1x,a6,i3,a43,i4,a1/)') & - 'ERROR ', status_pdaf, & - ' in PDAF_assimilate - stopping! (PE ', mype_world,')' + WRITE (*,"(/1x,a6,i3,a43,i4,a1/)") & + "ERROR ", status_pdaf, & + " in PDAF_assimilate - stopping! (PE ", mype_world,")" CALL abort_parallel() END IF diff --git a/interface/framework/callback_obs_pdafomi.F90 b/interface/framework/callback_obs_pdafomi.F90 index 35400936..c34031d3 100644 --- a/interface/framework/callback_obs_pdafomi.F90 +++ b/interface/framework/callback_obs_pdafomi.F90 @@ -75,13 +75,13 @@ SUBROUTINE init_dim_obs_pdafomi(step, dim_obs) ! in which order they are called if (mype_world==0 .and. screen > 2) then - write(*,*)'Call dimension initialization' + write(*,*)"Call dimension initialization" end if #ifdef PDAF_DEBUG if (mype_world==0) then - write(*,*)'PDAF-OMI-DEBUG: assim_GRACE=', assim_GRACE - write(*,*)'PDAF-OMI-DEBUG: assim_SM=', assim_SM + write(*,*)"PDAF-OMI-DEBUG: assim_GRACE=", assim_GRACE + write(*,*)"PDAF-OMI-DEBUG: assim_SM=", assim_SM ! write(*,*)'PDAF-OMI assim_C=', assim_C end if #endif @@ -134,7 +134,7 @@ SUBROUTINE obs_op_pdafomi(step, dim_p, dim_obs, state_p, ostate) ! order of the calls in init_dim_obs_pdafomi if (mype_world==0 .and. screen > 2) then - write(*,*)'Call observation operators' + write(*,*)"Call observation operators" end if IF (assim_GRACE) CALL obs_op_GRACE(dim_p, dim_obs, state_p, ostate) diff --git a/interface/framework/collect_state_pdaf.F90 b/interface/framework/collect_state_pdaf.F90 index f32139ff..da62f60b 100644 --- a/interface/framework/collect_state_pdaf.F90 +++ b/interface/framework/collect_state_pdaf.F90 @@ -115,7 +115,7 @@ SUBROUTINE collect_state_pdaf(dim_p, state_p) #ifdef PDAF_DEBUG ! Debug output: Collected state array DO i = 1, MIN(dim_p,6) - WRITE(*, '(a,x,a,i5,x,a,i1,a,x,f12.8)') "TSMP-PDAF-debug", "mype(w)=", mype_world, & + WRITE(*, "(a,x,a,i5,x,a,i1,a,x,f12.8)") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "collect_state_pdaf: state_p(", i, "):", state_p(i) END DO #endif diff --git a/interface/framework/distribute_state_pdaf.F90 b/interface/framework/distribute_state_pdaf.F90 index 36f2cf39..876c3c94 100644 --- a/interface/framework/distribute_state_pdaf.F90 +++ b/interface/framework/distribute_state_pdaf.F90 @@ -102,7 +102,7 @@ SUBROUTINE distribute_state_pdaf(dim_p, state_p) #ifdef PDAF_DEBUG ! Debug output: Distributed state array DO i = 1, MIN(dim_p,6) - WRITE(*, '(a,x,a,i5,x,a,i1,a,x,f12.8)') "TSMP-PDAF-debug", "mype(w)=", mype_world, & + WRITE(*, "(a,x,a,i5,x,a,i1,a,x,f12.8)") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "distribute_state_pdaf: state_p(", i, "):", state_p(i) END DO #endif diff --git a/interface/framework/distribute_stateinc_pdaf.F90 b/interface/framework/distribute_stateinc_pdaf.F90 index 0dbaf412..066df754 100644 --- a/interface/framework/distribute_stateinc_pdaf.F90 +++ b/interface/framework/distribute_stateinc_pdaf.F90 @@ -74,7 +74,7 @@ SUBROUTINE distribute_stateinc_pdaf(dim_p, state_inc_p, new_forecast, steps) ! At begin of each forecast phase distribute full increment to ! all processes and compute increment per update step. ! (E.g., at each time step) - ENDIF + END IF ! ************************************* diff --git a/interface/framework/g2l_state_pdaf.F90 b/interface/framework/g2l_state_pdaf.F90 index 987a2c25..f4edd5c1 100644 --- a/interface/framework/g2l_state_pdaf.F90 +++ b/interface/framework/g2l_state_pdaf.F90 @@ -84,7 +84,7 @@ SUBROUTINE g2l_state_pdaf(step, domain_p, dim_p, state_p, dim_l, state_l) DO i = 0, dim_l-1 nshift_p = domain_p + i * n_domain state_l(i+1) = state_p(nshift_p) - ENDDO + END DO else if (model == tag_model_clm) then state_l(dim_l) = state_p(domain_p) end if diff --git a/interface/framework/init_dim_obs_f_pdaf.F90 b/interface/framework/init_dim_obs_f_pdaf.F90 index 11547a4e..49d987ea 100755 --- a/interface/framework/init_dim_obs_f_pdaf.F90 +++ b/interface/framework/init_dim_obs_f_pdaf.F90 @@ -215,10 +215,10 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) is_multi_observation_files = .true. if (is_multi_observation_files) then ! Set name of current NetCDF observation file - write(current_observation_filename, '(a, i5.5)') trim(obs_filename)//'.', step + write(current_observation_filename, "(a, i5.5)") trim(obs_filename)//".", step else ! Single NetCDF observation file (currently NOT used) - write(current_observation_filename, '(a, i5.5)') trim(obs_filename) + write(current_observation_filename, "(a, i5.5)") trim(obs_filename) end if if (mype_filter == 0) then @@ -238,7 +238,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(point_obs==0) then call mpi_bcast(dim_nx, 1, MPI_INTEGER, 0, comm_filter, ierror) call mpi_bcast(dim_ny, 1, MPI_INTEGER, 0, comm_filter, ierror) - endif + end if ! broadcast damping factor flags call mpi_bcast(is_dampfac_state_time_dependent, 1, MPI_INTEGER, 0, comm_filter, ierror) call mpi_bcast(is_dampfac_param_time_dependent, 1, MPI_INTEGER, 0, comm_filter, ierror) @@ -311,7 +311,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if (multierr==1) then if (allocated(pressure_obserr)) deallocate(pressure_obserr) allocate(pressure_obserr(dim_obs)) - endif + end if if(allocated(idx_obs_nc)) deallocate(idx_obs_nc) allocate(idx_obs_nc(dim_obs)) if(allocated(x_idx_obs_nc))deallocate(x_idx_obs_nc) @@ -329,7 +329,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(point_obs==0) then if(allocated(var_id_obs_nc))deallocate(var_id_obs_nc) allocate(var_id_obs_nc(dim_ny, dim_nx)) - endif + end if !end if #endif #endif @@ -351,7 +351,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(point_obs==0) then if(allocated(var_id_obs_nc)) deallocate(var_id_obs_nc) allocate(var_id_obs_nc(dim_ny, dim_nx)) - endif + end if if(multierr==1) then if(allocated(clm_obserr)) deallocate(clm_obserr) allocate(clm_obserr(dim_obs)) @@ -699,14 +699,14 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(multierr==1) then if (allocated(pressure_obserr_p)) deallocate(pressure_obserr_p) allocate(pressure_obserr_p(dim_obs_p)) - endif + end if if(crns_flag==1) then if (allocated(sc_p)) deallocate(sc_p) allocate(sc_p(nz_glob, dim_obs_p)) if (allocated(idx_obs_nc_p)) deallocate(idx_obs_nc_p) allocate(idx_obs_nc_p(dim_obs_p)) - endif + end if !hcp fin if (point_obs==0) then @@ -770,7 +770,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) !hcp if(crns_flag==1) then idx_obs_nc(:)=nx_glob*(y_idx_obs_nc(:)-1)+x_idx_obs_nc(:) - endif + end if !hcp fin cnt = 1 do i = 1, dim_obs @@ -787,7 +787,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(crns_flag==1) then idx_obs_nc_p(cnt)=idx_obs_nc(i) !Allocate(sc_p(cnt)%scol_obs_in(nz_glob)) - endif + end if cnt = cnt + 1 end if end do @@ -798,10 +798,10 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) k_cnt=idx_obs_nc_p(i)+(k-1)*nx_glob*ny_glob do j = 1, enkf_subvecsize if (k_cnt == idx_map_subvec2state_fortran(j)) sc_p(nz_glob-k+1,i)=j - enddo - enddo - endif - enddo + end do + end do + end if + end do if(obs_interp_switch==1) then ! loop over all obs and save the indices of the nearest grid @@ -873,7 +873,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) if(multierr==1) then if (allocated(clm_obserr_p)) deallocate(clm_obserr_p) allocate(clm_obserr_p(dim_obs_p)) - endif + end if if(point_obs==0) then max_var_id = MAXVAL(var_id_obs_nc(:,:)) if(allocated(lon_var_id)) deallocate(lon_var_id) @@ -909,8 +909,8 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) lon_var_id(j) = (maxlon(j) + minlon(j))/2.0 lat_var_id(j) = (maxlat(j) + minlat(j))/2.0 !print *, 'j lon_var_id lat_var_id ', j, lon_var_id(j), lat_var_id(j) - enddo ! allocate clm_obserr_p observation error for clm run at PE-local domain - enddo + end do ! allocate clm_obserr_p observation error for clm run at PE-local domain + end do cnt = 1 do m = 1, dim_nx @@ -924,7 +924,7 @@ SUBROUTINE init_dim_obs_f_pdaf(step, dim_obs_f) var_id_obs(cnt) = var_id_obs_nc(l,m) if(multierr==1) clm_obserr_p(cnt) = clm_obserr(i) cnt = cnt + 1 - endif + end if end do end do end do diff --git a/interface/framework/init_dim_obs_l_pdaf.F90 b/interface/framework/init_dim_obs_l_pdaf.F90 index 04c25803..df87ee1c 100755 --- a/interface/framework/init_dim_obs_l_pdaf.F90 +++ b/interface/framework/init_dim_obs_l_pdaf.F90 @@ -141,7 +141,7 @@ SUBROUTINE init_dim_obs_l_pdaf(domain_p, step, dim_obs_f, dim_obs_l) call C_F_POINTER(xcoord, xcoord_fortran, [enkf_subvecsize]) call C_F_POINTER(ycoord, ycoord_fortran, [enkf_subvecsize]) call C_F_POINTER(zcoord, zcoord_fortran, [enkf_subvecsize]) - ENDIF + END IF ! Index for local analysis domain `domain_p` in coordinate array ! that only spans `enkf_subvecsize`. @@ -208,8 +208,8 @@ SUBROUTINE init_dim_obs_l_pdaf(domain_p, step, dim_obs_f, dim_obs_l) obsind(i) = 1 end if end do - endif - endif + end if + end if #endif #endif @@ -242,8 +242,8 @@ SUBROUTINE init_dim_obs_l_pdaf(domain_p, step, dim_obs_f, dim_obs_l) end if end if end do - enddo - enddo + end do + end do do m = 1, dim_nx do k = 1, dim_ny @@ -264,8 +264,8 @@ SUBROUTINE init_dim_obs_l_pdaf(domain_p, step, dim_obs_f, dim_obs_l) end if end if end do - enddo - enddo + end do + end do end if else if(model == tag_model_clm) THEN diff --git a/interface/framework/init_dim_obs_pdaf.F90 b/interface/framework/init_dim_obs_pdaf.F90 index 48f29c08..f4c9ae8c 100755 --- a/interface/framework/init_dim_obs_pdaf.F90 +++ b/interface/framework/init_dim_obs_pdaf.F90 @@ -211,10 +211,10 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) is_multi_observation_files = .true. if (is_multi_observation_files) then ! Set name of current NetCDF observation file - write(current_observation_filename, '(a, i5.5)') trim(obs_filename)//'.', step + write(current_observation_filename, "(a, i5.5)") trim(obs_filename)//".", step else ! Single NetCDF observation file (currently NOT used) - write(current_observation_filename, '(a, i5.5)') trim(obs_filename) + write(current_observation_filename, "(a, i5.5)") trim(obs_filename) end if if (mype_filter == 0) then @@ -234,7 +234,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(point_obs==0) then call mpi_bcast(dim_nx, 1, MPI_INTEGER, 0, comm_filter, ierror) call mpi_bcast(dim_ny, 1, MPI_INTEGER, 0, comm_filter, ierror) - endif + end if ! broadcast damping factor flags call mpi_bcast(is_dampfac_state_time_dependent, 1, MPI_INTEGER, 0, comm_filter, ierror) call mpi_bcast(is_dampfac_param_time_dependent, 1, MPI_INTEGER, 0, comm_filter, ierror) @@ -307,7 +307,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if (multierr==1) then if (allocated(pressure_obserr)) deallocate(pressure_obserr) allocate(pressure_obserr(dim_obs)) - endif + end if if(allocated(idx_obs_nc)) deallocate(idx_obs_nc) allocate(idx_obs_nc(dim_obs)) if(allocated(x_idx_obs_nc))deallocate(x_idx_obs_nc) @@ -325,7 +325,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(point_obs==0) then if(allocated(var_id_obs_nc))deallocate(var_id_obs_nc) allocate(var_id_obs_nc(dim_ny, dim_nx)) - endif + end if !end if #endif #endif @@ -347,7 +347,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(point_obs==0) then if(allocated(var_id_obs_nc)) deallocate(var_id_obs_nc) allocate(var_id_obs_nc(dim_ny, dim_nx)) - endif + end if if(multierr==1) then if(allocated(clm_obserr)) deallocate(clm_obserr) allocate(clm_obserr(dim_obs)) @@ -692,14 +692,14 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(multierr==1) then if (allocated(pressure_obserr_p)) deallocate(pressure_obserr_p) allocate(pressure_obserr_p(dim_obs_p)) - endif + end if if(crns_flag==1) then if (allocated(sc_p)) deallocate(sc_p) allocate(sc_p(nz_glob, dim_obs_p)) if (allocated(idx_obs_nc_p)) deallocate(idx_obs_nc_p) allocate(idx_obs_nc_p(dim_obs_p)) - endif + end if !hcp fin if (point_obs==0) then @@ -763,7 +763,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) !hcp if(crns_flag==1) then idx_obs_nc(:)=nx_glob*(y_idx_obs_nc(:)-1)+x_idx_obs_nc(:) - endif + end if !hcp fin cnt = 1 do i = 1, dim_obs @@ -780,7 +780,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(crns_flag==1) then idx_obs_nc_p(cnt)=idx_obs_nc(i) !Allocate(sc_p(cnt)%scol_obs_in(nz_glob)) - endif + end if cnt = cnt + 1 end if end do @@ -791,10 +791,10 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) k_cnt=idx_obs_nc_p(i)+(k-1)*nx_glob*ny_glob do j = 1, enkf_subvecsize if (k_cnt == idx_map_subvec2state_fortran(j)) sc_p(nz_glob-k+1,i)=j - enddo - enddo - endif - enddo + end do + end do + end if + end do if(obs_interp_switch==1) then ! loop over all obs and save the indices of the nearest grid @@ -866,7 +866,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) if(multierr==1) then if (allocated(clm_obserr_p)) deallocate(clm_obserr_p) allocate(clm_obserr_p(dim_obs_p)) - endif + end if if(point_obs==0) then max_var_id = MAXVAL(var_id_obs_nc(:,:)) if(allocated(lon_var_id)) deallocate(lon_var_id) @@ -902,8 +902,8 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) lon_var_id(j) = (maxlon(j) + minlon(j))/2.0 lat_var_id(j) = (maxlat(j) + minlat(j))/2.0 !print *, 'j lon_var_id lat_var_id ', j, lon_var_id(j), lat_var_id(j) - enddo ! allocate clm_obserr_p observation error for clm run at PE-local domain - enddo + end do ! allocate clm_obserr_p observation error for clm run at PE-local domain + end do cnt = 1 do m = 1, dim_nx @@ -917,7 +917,7 @@ SUBROUTINE init_dim_obs_pdaf(step, dim_obs_p) var_id_obs(cnt) = var_id_obs_nc(l,m) if(multierr==1) clm_obserr_p(cnt) = clm_obserr(i) cnt = cnt + 1 - endif + end if end do end do end do diff --git a/interface/framework/init_ens.F90 b/interface/framework/init_ens.F90 index 1c6ee454..b02970aa 100644 --- a/interface/framework/init_ens.F90 +++ b/interface/framework/init_ens.F90 @@ -91,9 +91,9 @@ SUBROUTINE init_ens(filtertype, dim_p, dim_ens, state_p, Uinv, & ! *** Generate full ensemble on filter-PE 0 *** IF (mype_filter==0 .and. screen > 0) THEN - WRITE (*, '(/9x, a)') 'Initialize state ensemble' - WRITE (*, '(9x, a)') '--- read ensemble from files' - WRITE (*, '(9x, a, i5)') '--- Ensemble size: ', dim_ens + WRITE (*, "(/9x, a)") "Initialize state ensemble" + WRITE (*, "(9x, a)") "--- read ensemble from files" + WRITE (*, "(9x, a, i5)") "--- Ensemble size: ", dim_ens END IF diff --git a/interface/framework/init_obscovar_pdaf.F90 b/interface/framework/init_obscovar_pdaf.F90 index bce76cf5..5df879f1 100644 --- a/interface/framework/init_obscovar_pdaf.F90 +++ b/interface/framework/init_obscovar_pdaf.F90 @@ -111,8 +111,8 @@ SUBROUTINE init_obscovar_pdaf(step, dim_obs, dim_obs_p, covar, m_state_p, & if(multierr/=1) then DO i = 1, dim_obs covar(i, i) = variance_obs - ENDDO - endif + END DO + end if if(multierr==1) then @@ -129,8 +129,8 @@ SUBROUTINE init_obscovar_pdaf(step, dim_obs, dim_obs_p, covar, m_state_p, & #else covar(i,i) = pressure_obserr(obs_pdaf2nc(i))*pressure_obserr(obs_pdaf2nc(i)) #endif - enddo - endif + end do + end if ! The matrix is diagonal ! This setting avoids the computation of the SVD of COVAR ! in PDAF_enkf_obs_ensemble diff --git a/interface/framework/init_obsvar_pdaf.F90 b/interface/framework/init_obsvar_pdaf.F90 index a73515af..87f5e512 100644 --- a/interface/framework/init_obsvar_pdaf.F90 +++ b/interface/framework/init_obsvar_pdaf.F90 @@ -93,7 +93,7 @@ SUBROUTINE init_obsvar_pdaf(step, dim_obs_p, obs_p, meanvar) ! *** Compute mean variance *** ! ***************************** - WRITE (*,*) 'TEMPLATE init_obsvar_pdaf.F90: Set mean observation variance here!' + WRITE (*,*) "TEMPLATE init_obsvar_pdaf.F90: Set mean observation variance here!" ! We assume that all observations have the same error. ! Thus, the mean variance is the error variance of each single observation. @@ -111,8 +111,8 @@ SUBROUTINE init_obsvar_pdaf(step, dim_obs_p, obs_p, meanvar) if(pressure_obserr_p(i) /= 0) then sum_p = sum_p + pressure_obserr_p(i) counter = counter + 1 - endif - enddo + end if + end do ! averaging the sum of observation errors with total no of non-zero observations meanvar_p = sum_p/counter ! summing the average of observation errors and communicating it back to each rank @@ -131,8 +131,8 @@ SUBROUTINE init_obsvar_pdaf(step, dim_obs_p, obs_p, meanvar) if(clm_obserr_p(i) /= 0) then sum_p = sum_p + clm_obserr_p(i) counter = counter + 1 - endif - enddo + end if + end do ! averaging the sum of observation errors with total no of non-zero observations meanvar_p = sum_p/counter ! summing the average of observation errors and communicating it back to each rank diff --git a/interface/framework/init_parallel_pdaf.F90 b/interface/framework/init_parallel_pdaf.F90 index 98528e7a..c41598af 100644 --- a/interface/framework/init_parallel_pdaf.F90 +++ b/interface/framework/init_parallel_pdaf.F90 @@ -158,50 +158,51 @@ SUBROUTINE init_parallel_pdaf(dim_ens, screen) ! *** Print TSMP-PDAF information *** IF (mype_world==0) THEN - WRITE(*, '(/a)') 'TSMP-PDAF ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++' - WRITE(*, '(a)') 'TSMP-PDAF +++ TSMP-PDAF +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ Please cite +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ Kurtz, W., He, G., Kollet, S. J., Maxwell, R. M., +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ Vereecken, H., & Hendricks Franssen, H. J. (2016). +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ TerrSysMP-PDAF (version 1.0): a modular +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ high-performance data assimilation framework for +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ an integrated land surface-subsurface model. +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ Geoscientific Model Development, 9(4), 1341-1360. +++' - WRITE(*, '(a)') 'TSMP-PDAF +++ doi: 10.5194/gmd-9-1341-2016 +++' - WRITE(*, '(a/)') 'TSMP-PDAF ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++' + WRITE(*, "(/a)") "TSMP-PDAF ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" + WRITE(*, "(a)") "TSMP-PDAF +++ TSMP-PDAF +++" + WRITE(*, "(a)") "TSMP-PDAF +++ +++" + WRITE(*, "(a)") "TSMP-PDAF +++ Please cite +++" + WRITE(*, "(a)") "TSMP-PDAF +++ Kurtz, W., He, G., Kollet, S. J., Maxwell, R. M., +++" + WRITE(*, "(a)") "TSMP-PDAF +++ Vereecken, H., & Hendricks Franssen, H. J. (2016). +++" + WRITE(*, "(a)") "TSMP-PDAF +++ TerrSysMP-PDAF (version 1.0): a modular +++" + WRITE(*, "(a)") "TSMP-PDAF +++ high-performance data assimilation framework for +++" + WRITE(*, "(a)") "TSMP-PDAF +++ an integrated land surface-subsurface model. +++" + WRITE(*, "(a)") "TSMP-PDAF +++ Geoscientific Model Development, 9(4), 1341-1360. +++" + WRITE(*, "(a)") "TSMP-PDAF +++ doi: 10.5194/gmd-9-1341-2016 +++" + WRITE(*, "(a/)") "TSMP-PDAF ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++" END IF ! *** Parse number of model tasks *** - handle = 'n_modeltasks' + handle = "n_modeltasks" CALL parse(handle, n_modeltasks) ! *** Initialize communicators for ensemble evaluations *** - IF (mype_world == 0) & - WRITE (*, '(/1x, a)') 'Initialize communicators for assimilation with PDAF' + IF (mype_world == 0) then + WRITE (*, "(/1x, a)") "Initialize communicators for assimilation with PDAF" + end if ! *** Check consistency of number of parallel ensemble tasks *** consist1: IF (n_modeltasks > npes_world) THEN ! *** # parallel tasks is set larger than available PEs *** n_modeltasks = npes_world - IF (mype_world == 0) WRITE (*, '(3x, a)') & - '!!! Resetting number of parallel ensemble tasks to total number of PEs!' + IF (mype_world == 0) WRITE (*, "(3x, a)") & + "!!! Resetting number of parallel ensemble tasks to total number of PEs!" END IF consist1 IF (dim_ens > 0) THEN ! Check consistency with ensemble size consist2: IF (n_modeltasks > dim_ens) THEN ! # parallel ensemble tasks is set larger than ensemble size n_modeltasks = dim_ens - IF (mype_world == 0) WRITE (*, '(5x, a)') & - '!!! Resetting number of parallel ensemble tasks to number of ensemble states!' + IF (mype_world == 0) WRITE (*, "(5x, a)") & + "!!! Resetting number of parallel ensemble tasks to number of ensemble states!" END IF consist2 END IF consist3: IF (modulo(npes_world, n_modeltasks) /= 0) THEN ! *** # parallel tasks is a divisor of # available PEs *** - IF (mype_world == 0) WRITE (*, '(3x, a)') & - 'Error: n_modeltasks should be a divisor of npes_world.' + IF (mype_world == 0) WRITE (*, "(3x, a)") & + "Error: n_modeltasks should be a divisor of npes_world." stop END IF consist3 @@ -250,8 +251,8 @@ SUBROUTINE init_parallel_pdaf(dim_ens, screen) CALL MPI_Comm_Rank(COMM_model, mype_model, MPIerr) if (screen > 1) then - write (*,*) 'MODEL: mype(w)= ', mype_world, '; model task: ', task_id, & - '; mype(m)= ', mype_model, '; npes(m)= ', npes_model + write (*,*) "MODEL: mype(w)= ", mype_world, "; model task: ", task_id, & + "; mype(m)= ", mype_model, "; npes(m)= ", npes_model end if @@ -293,25 +294,25 @@ SUBROUTINE init_parallel_pdaf(dim_ens, screen) IF (screen > 0) THEN IF (mype_world == 0) THEN - WRITE (*, '(/a, 18x, a)') 'Pconf', 'PE configuration:' - WRITE (*, '(a, 2x, a6, a9, a10, a14, a13, /a, 2x, a5, a9, a7, a7, a7, a7, a7, /a, 2x, a)') & - 'Pconf', 'world', 'filter', 'model', 'couple', 'filterPE', & - 'Pconf', 'rank', 'rank', 'task', 'rank', 'task', 'rank', 'T/F', & - 'Pconf', '----------------------------------------------------------' + WRITE (*, "(/a, 18x, a)") "Pconf", "PE configuration:" + WRITE (*, "(a, 2x, a6, a9, a10, a14, a13, /a, 2x, a5, a9, a7, a7, a7, a7, a7, /a, 2x, a)") & + "Pconf", "world", "filter", "model", "couple", "filterPE", & + "Pconf", "rank", "rank", "task", "rank", "task", "rank", "T/F", & + "Pconf", "----------------------------------------------------------" END IF CALL MPI_Barrier(MPI_COMM_WORLD, MPIerr) IF (task_id == 1) THEN - WRITE (*, '(a, 2x, i4, 4x, i4, 4x, i3, 4x, i3, 4x, i3, 4x, i3, 5x, l3)') & - 'Pconf', mype_world, mype_filter, task_id, mype_model, color_couple, & + WRITE (*, "(a, 2x, i4, 4x, i4, 4x, i3, 4x, i3, 4x, i3, 4x, i3, 5x, l3)") & + "Pconf", mype_world, mype_filter, task_id, mype_model, color_couple, & mype_couple, filterpe - ENDIF + END IF IF (task_id > 1) THEN - WRITE (*, '(a, 2x, i4, 12x, i3, 4x, i3, 4x, i3, 4x, i3, 5x, l3)') & - 'Pconf', mype_world, task_id, mype_model, color_couple, mype_couple, filterpe + WRITE (*, "(a, 2x, i4, 12x, i3, 4x, i3, 4x, i3, 4x, i3, 5x, l3)") & + "Pconf", mype_world, task_id, mype_model, color_couple, mype_couple, filterpe END IF CALL MPI_Barrier(MPI_COMM_WORLD, MPIerr) - IF (mype_world == 0) WRITE (*, '(/a)') '' + IF (mype_world == 0) WRITE (*, "(/a)") "" END IF diff --git a/interface/framework/init_pdaf.F90 b/interface/framework/init_pdaf.F90 index eb68b077..12528681 100644 --- a/interface/framework/init_pdaf.F90 +++ b/interface/framework/init_pdaf.F90 @@ -156,7 +156,7 @@ SUBROUTINE init_pdaf() ! *************************** IF (mype_world == 0) THEN - WRITE (*,'(/1x,a)') 'INITIALIZE PDAF - ONLINE MODE' + WRITE (*,"(/1x,a)") "INITIALIZE PDAF - ONLINE MODE" END IF ! *** Pointer initialization for ParFlow-type state vector *** @@ -217,7 +217,7 @@ SUBROUTINE init_pdaf() #ifdef PDAF_DEBUG ! Debug output: local state dimension array - if (mype_model == 0) WRITE(*, '(a,x,a,i5,x,a,x)', advance="no") "TSMP-PDAF-debug", "mype(w)=", mype_world, & + if (mype_model == 0) WRITE(*, "(a,x,a,i5,x,a,x)", advance="no") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "init_pdaf: dim_state_p_count in modified:" if (mype_model == 0) WRITE(*, *) dim_state_p_count #endif @@ -229,9 +229,9 @@ SUBROUTINE init_pdaf() #ifdef PDAF_DEBUG ! Debug output: global state dimension - WRITE(*, '(a,x,a,i5,x,a,x,i9)') "TSMP-PDAF-debug", "mype(w)=", mype_world, & + WRITE(*, "(a,x,a,i5,x,a,x,i9)") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "init_pdaf: my local state vector dimension dim_state_p:", dim_state_p - WRITE(*, '(a,x,a,i5,x,a,2x,i9)') "TSMP-PDAF-debug", "mype(w)=", mype_world, & + WRITE(*, "(a,x,a,i5,x,a,2x,i9)") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "init_pdaf: my global state vector dimension dim_state:", dim_state #endif @@ -319,7 +319,7 @@ SUBROUTINE init_pdaf() ! or radius for 1/e for exponential weighting ! *** File names - filename = 'output.dat' + filename = "output.dat" ! *** TSMP-PDAF-specific inputs !kuw: add smoother support @@ -406,9 +406,9 @@ SUBROUTINE init_pdaf() ! *** Check whether initialization of PDAF was successful *** IF (status_pdaf /= 0) THEN - WRITE (*,'(/1x,a6,i3,a43,i4,a1/)') & - 'ERROR ', status_pdaf, & - ' in initialization of PDAF - stopping! (PE ', mype_world,')' + WRITE (*,"(/1x,a6,i3,a43,i4,a1/)") & + "ERROR ", status_pdaf, & + " in initialization of PDAF - stopping! (PE ", mype_world,")" CALL abort_parallel() END IF diff --git a/interface/framework/init_pdaf_info.F90 b/interface/framework/init_pdaf_info.F90 index 9452c6b5..800ff034 100644 --- a/interface/framework/init_pdaf_info.F90 +++ b/interface/framework/init_pdaf_info.F90 @@ -62,212 +62,212 @@ SUBROUTINE init_pdaf_info() ! ***************************** IF (filtertype == 1) THEN - WRITE (*, '(21x, a)') 'Filter: SEIK' + WRITE (*, "(21x, a)") "Filter: SEIK" IF (subtype == 2) THEN - WRITE (*, '(6x, a)') '-- fixed error-space basis' + WRITE (*, "(6x, a)") "-- fixed error-space basis" ELSE IF (subtype == 3) THEN - WRITE (*, '(6x, a)') '-- fixed state covariance matrix' + WRITE (*, "(6x, a)") "-- fixed state covariance matrix" ELSE IF (subtype == 4) THEN - WRITE (*, '(6x, a)') '-- use ensemble transformation' + WRITE (*, "(6x, a)") "-- use ensemble transformation" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*,'(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*,"(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 2) THEN - WRITE (*, '(21x, a)') 'Filter: EnKF' + WRITE (*, "(21x, a)") "Filter: EnKF" IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF IF (rank_analysis_enkf > 0) THEN - WRITE (*, '(6x, a, i5)') & - 'analysis with pseudo-inverse of HPH, rank:', rank_analysis_enkf + WRITE (*, "(6x, a, i5)") & + "analysis with pseudo-inverse of HPH, rank:", rank_analysis_enkf END IF ELSE IF (filtertype == 3) THEN - WRITE (*, '(21x, a)') 'Filter: LSEIK' + WRITE (*, "(21x, a)") "Filter: LSEIK" IF (subtype == 2) THEN - WRITE (*, '(6x, a)') '-- fixed error-space basis' + WRITE (*, "(6x, a)") "-- fixed error-space basis" ELSE IF (subtype == 3) THEN - WRITE (*, '(6x, a)') '-- fixed state covariance matrix' + WRITE (*, "(6x, a)") "-- fixed state covariance matrix" ELSE IF (subtype == 4) THEN - WRITE (*, '(6x, a)') '-- use ensemble transformation' + WRITE (*, "(6x, a)") "-- use ensemble transformation" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 4) THEN - WRITE (*, '(21x, a)') 'Filter: ETKF' + WRITE (*, "(21x, a)") "Filter: ETKF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Variant using T-matrix' + WRITE (*, "(6x, a)") "-- Variant using T-matrix" ELSE IF (subtype == 1) THEN - WRITE (*, '(6x, a)') '-- Variant following Hunt et al. (2007)' + WRITE (*, "(6x, a)") "-- Variant following Hunt et al. (2007)" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*,'(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*,"(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 5) THEN - WRITE (*, '(21x, a)') 'Filter: LETKF' + WRITE (*, "(21x, a)") "Filter: LETKF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Variant using T-matrix' + WRITE (*, "(6x, a)") "-- Variant using T-matrix" ELSE IF (subtype == 1) THEN - WRITE (*, '(6x, a)') '-- Variant following Hunt et al. (2007)' + WRITE (*, "(6x, a)") "-- Variant following Hunt et al. (2007)" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 6) THEN - WRITE (*, '(21x, a)') 'Filter: ESTKF' + WRITE (*, "(21x, a)") "Filter: ESTKF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*,'(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*,"(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 7) THEN - WRITE (*, '(21x, a)') 'Filter: LESTKF' + WRITE (*, "(21x, a)") "Filter: LESTKF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 8) THEN - WRITE (*, '(21x, a)') 'Filter: localized EnKF' + WRITE (*, "(21x, a)") "Filter: localized EnKF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF IF (rank_analysis_enkf > 0) THEN - WRITE (*, '(6x, a, i5)') & - 'analysis with pseudo-inverse of HPH, rank:', rank_analysis_enkf + WRITE (*, "(6x, a, i5)") & + "analysis with pseudo-inverse of HPH, rank:", rank_analysis_enkf END IF ELSE IF (filtertype == 9) THEN - WRITE (*, '(21x, a)') 'Filter: NETF' + WRITE (*, "(21x, a)") "Filter: NETF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 10) THEN - WRITE (*, '(21x, a)') 'Filter: LNETF' + WRITE (*, "(21x, a)") "Filter: LNETF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (dim_lag > 0) WRITE (*, '(15x, a, i5)') 'smoother lag:', dim_lag - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f5.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (dim_lag > 0) WRITE (*, "(15x, a, i5)") "smoother lag:", dim_lag + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f5.2)") "forgetting factor:", forget IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 11) THEN - WRITE (*, '(21x, a)') 'Filter: LKNETF' + WRITE (*, "(21x, a)") "Filter: LKNETF" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- HNK: 2-step LKNETF with NETF before LETKF' + WRITE (*, "(6x, a)") "-- HNK: 2-step LKNETF with NETF before LETKF" ELSE IF (subtype == 1) THEN - WRITE (*, '(6x, a)') '-- HKN: 2-step LKNETF with LETKF before NETF' + WRITE (*, "(6x, a)") "-- HKN: 2-step LKNETF with LETKF before NETF" ELSE IF (subtype == 4) THEN - WRITE (*, '(6x, a)') '-- HSync: LKNETF synchronous' + WRITE (*, "(6x, a)") "-- HSync: LKNETF synchronous" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode - HNK: 2-step LKNETF with NETF before LETKF' + WRITE (*, "(6x, a)") "-- Offline mode - HNK: 2-step LKNETF with NETF before LETKF" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(10x, a, f7.2)') 'forgetting factor:', forget + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(10x, a, f7.2)") "forgetting factor:", forget IF (type_hyb == 0) THEN - ELSEIF (type_hyb == 0) THEN - WRITE (*, '(6x, a)') '-- use fixed hybrid weight hyb_gamma' - ELSEIF (type_hyb == 1) THEN - WRITE (*, '(6x, a)') '-- use gamma_lin: (1 - N_eff/N_e)*hyb_gamma' - ELSEIF (type_hyb == 2) THEN - WRITE (*, '(6x, a)') '-- use gamma_alpha: hybrid weight from N_eff/N>=hyb_gamma' - ELSEIF (type_hyb == 3) THEN - WRITE (*, '(6x, a)') '-- use gamma_ska: 1 - min(s,k)/sqrt(hyb_kappa) with N_eff/N>=hyb_gamma' - ELSEIF (type_hyb == 4) THEN - WRITE (*, '(6x, a)') '-- use gamma_sklin: 1 - min(s,k)/sqrt(hyb_kappa) >= 1-N_eff/N>=hyb_gamma' + ELSE IF (type_hyb == 0) THEN + WRITE (*, "(6x, a)") "-- use fixed hybrid weight hyb_gamma" + ELSE IF (type_hyb == 1) THEN + WRITE (*, "(6x, a)") "-- use gamma_lin: (1 - N_eff/N_e)*hyb_gamma" + ELSE IF (type_hyb == 2) THEN + WRITE (*, "(6x, a)") "-- use gamma_alpha: hybrid weight from N_eff/N>=hyb_gamma" + ELSE IF (type_hyb == 3) THEN + WRITE (*, "(6x, a)") "-- use gamma_ska: 1 - min(s,k)/sqrt(hyb_kappa) with N_eff/N>=hyb_gamma" + ELSE IF (type_hyb == 4) THEN + WRITE (*, "(6x, a)") "-- use gamma_sklin: 1 - min(s,k)/sqrt(hyb_kappa) >= 1-N_eff/N>=hyb_gamma" END IF - WRITE (*, '(8x, a, f7.2)') 'hybrid weight gamma:', hyb_gamma - WRITE (*, '(10x, a, f7.2)') 'hybrid norm kappa:', hyb_kappa + WRITE (*, "(8x, a, f7.2)") "hybrid weight gamma:", hyb_gamma + WRITE (*, "(10x, a, f7.2)") "hybrid norm kappa:", hyb_kappa IF (model_error) THEN - WRITE (*, '(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*, "(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 12) THEN - WRITE (*, '(21x, a)') 'Filter: PF with resampling' + WRITE (*, "(21x, a)") "Filter: PF with resampling" IF (subtype == 0) THEN - WRITE (*, '(6x, a)') '-- Standard mode' + WRITE (*, "(6x, a)") "-- Standard mode" ELSE IF (subtype == 5) THEN - WRITE (*, '(6x, a)') '-- Offline mode' + WRITE (*, "(6x, a)") "-- Offline mode" END IF - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens - IF (subtype /= 5) WRITE (*, '(6x, a, i5)') 'Assimilation interval:', delt_obs - WRITE (*, '(13x, a, i5)') 'reampling type:', pf_res_type - WRITE (*, '(17x, a, i5)') 'noise type:', pf_noise_type - WRITE (*, '(12x, a, f8.3)') 'noise amplitude:', pf_noise_amp + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens + IF (subtype /= 5) WRITE (*, "(6x, a, i5)") "Assimilation interval:", delt_obs + WRITE (*, "(13x, a, i5)") "reampling type:", pf_res_type + WRITE (*, "(17x, a, i5)") "noise type:", pf_noise_type + WRITE (*, "(12x, a, f8.3)") "noise amplitude:", pf_noise_amp IF (model_error) THEN - WRITE (*,'(6x, a, f5.2)') 'model error amplitude:', model_err_amp + WRITE (*,"(6x, a, f5.2)") "model error amplitude:", model_err_amp END IF ELSE IF (filtertype == 100) THEN - WRITE (*, '(6x, a, f5.2)') '-- Generate observations --' + WRITE (*, "(6x, a, f5.2)") "-- Generate observations --" IF (dim_ens>1) THEN - WRITE (*, '(14x, a)') 'Use ensemble mean for observations' - WRITE (*, '(14x, a, i5)') 'ensemble size:', dim_ens + WRITE (*, "(14x, a)") "Use ensemble mean for observations" + WRITE (*, "(14x, a, i5)") "ensemble size:", dim_ens ELSE - WRITE (*, '(14x, a)') 'Generate observations from single ensemble state' + WRITE (*, "(14x, a)") "Generate observations from single ensemble state" END IF END IF diff --git a/interface/framework/init_pdaf_parse.F90 b/interface/framework/init_pdaf_parse.F90 index 1a15295a..9a3356c3 100644 --- a/interface/framework/init_pdaf_parse.F90 +++ b/interface/framework/init_pdaf_parse.F90 @@ -86,46 +86,46 @@ SUBROUTINE init_pdaf_parse() ! ********************************** ! Settings for model and time stepping - handle = 'model_error' ! Control application of model error + handle = "model_error" ! Control application of model error CALL parse(handle, model_error) - handle = 'model_err_amp' ! Amplitude of model error + handle = "model_err_amp" ! Amplitude of model error CALL parse(handle, model_err_amp) ! Observation settings - handle = 'delt_obs' ! Time step interval between filter analyses + handle = "delt_obs" ! Time step interval between filter analyses CALL parse(handle, delt_obs) - handle = 'toffset' ! Offset in time steps + handle = "toffset" ! Offset in time steps CALL parse(handle, toffset) - handle = 'rms_obs' ! Assumed uniform RMS error of the observations + handle = "rms_obs" ! Assumed uniform RMS error of the observations CALL parse(handle, rms_obs) #ifdef CLMFIVE rms_obs_GRACE = rms_obs ! backward compatibility - handle = 'rms_obs_GRACE' ! RMS error for GRACE observations + handle = "rms_obs_GRACE" ! RMS error for GRACE observations CALL parse(handle, rms_obs_GRACE) rms_obs_SM = rms_obs ! backward compatibility - handle = 'rms_obs_SM' ! RMS error for SM observations + handle = "rms_obs_SM" ! RMS error for SM observations CALL parse(handle, rms_obs_SM) ! rms_obs_C = rms_obs ! backward compatibility ! handle = 'rms_obs_C' ! RMS error for C observations ! CALL parse(handle, rms_obs_C) #endif - handle = 'dim_obs' ! Number of observations + handle = "dim_obs" ! Number of observations CALL parse(handle, dim_obs) ! General settings for PDAF - handle = 'screen' ! set verbosity of PDAF + handle = "screen" ! set verbosity of PDAF CALL parse(handle, screen) - handle = 'dim_ens' ! set ensemble size/rank of covar matrix + handle = "dim_ens" ! set ensemble size/rank of covar matrix CALL parse(handle, dim_ens) - handle = 'filtertype' ! Choose filter algorithm + handle = "filtertype" ! Choose filter algorithm CALL parse(handle, filtertype) - handle = 'subtype' ! Set subtype of filter + handle = "subtype" ! Set subtype of filter CALL parse(handle, subtype) - handle = 'incremental' ! Set whether to use incremental updating + handle = "incremental" ! Set whether to use incremental updating CALL parse(handle, incremental) - handle = 'use_omi' ! Set whether to use OMI interface + handle = "use_omi" ! Set whether to use OMI interface CALL parse(handle, use_omi) #if defined CLMSA #ifdef CLMFIVE @@ -134,59 +134,59 @@ SUBROUTINE init_pdaf_parse() #endif ! Filter-specific settings - handle = 'type_trans' ! Type of ensemble transformation in SEIK/ETKF/LSEIK/LETKF + handle = "type_trans" ! Type of ensemble transformation in SEIK/ETKF/LSEIK/LETKF CALL parse(handle, type_trans) - handle = 'rank_analysis_enkf' ! Set rank for pseudo inverse in EnKF + handle = "rank_analysis_enkf" ! Set rank for pseudo inverse in EnKF CALL parse(handle, rank_analysis_enkf) - handle = 'type_forget' ! Set type of forgetting factor + handle = "type_forget" ! Set type of forgetting factor CALL parse(handle, type_forget) - handle = 'forget' ! Set forgetting factor + handle = "forget" ! Set forgetting factor CALL parse(handle,forget) - handle = 'type_sqrt' ! Set type of transformation square-root (SEIK-sub4, ESTKF) + handle = "type_sqrt" ! Set type of transformation square-root (SEIK-sub4, ESTKF) CALL parse(handle, type_sqrt) ! Settings for localization in LSEIK/LETKF - handle = 'local_range' ! For backward compatibility + handle = "local_range" ! For backward compatibility CALL parse(handle, cradius) - handle = 'cradius' ! Set cut-off radius in grid points for observation domain + handle = "cradius" ! Set cut-off radius in grid points for observation domain CALL parse(handle, cradius) - handle = 'locweight' ! Set type of localizating weighting + handle = "locweight" ! Set type of localizating weighting CALL parse(handle, locweight) sradius = cradius ! By default use cradius as support radius - handle = 'srange' ! For backward compatibility + handle = "srange" ! For backward compatibility CALL parse(handle, sradius) - handle = 'sradius' ! Set support radius in grid points + handle = "sradius" ! Set support radius in grid points ! for 5th-order polynomial or radius for 1/e in exponential weighting CALL parse(handle, sradius) ! Settings for different observation types cradius_GRACE = cradius ! For backward compatibility - handle = 'cradius_GRACE' ! Set cut-off radius for GRACE observations + handle = "cradius_GRACE" ! Set cut-off radius for GRACE observations call parse(handle, cradius_GRACE) sradius_GRACE = sradius ! For backward compatibility - handle = 'sradius_GRACE' ! Set support radius for GRACE observations + handle = "sradius_GRACE" ! Set support radius for GRACE observations call parse(handle, sradius_GRACE) cradius_SM = cradius ! For backward compatibility - handle = 'cradius_SM' ! Set cut-off radius for SM observations + handle = "cradius_SM" ! Set cut-off radius for SM observations call parse(handle, cradius_SM) sradius_SM = sradius ! For backward compatibility - handle = 'sradius_SM' ! Set support radius for SM observations + handle = "sradius_SM" ! Set support radius for SM observations call parse(handle, sradius_SM) ! Setting for file output - handle = 'filename' ! Set name of output file + handle = "filename" ! Set name of output file CALL parse(handle, filename) ! *** user defined observation filename *** ! - handle = 'obs_filename' + handle = "obs_filename" call parse(handle, obs_filename) ! *** Yorck: user defined filename for temporal mean of TWS to be subtracted in observation operator *** ! - handle = 'temp_mean_filename' + handle = "temp_mean_filename" call parse(handle, temp_mean_filename) !kuw: add smoother support - handle = 'smoother_lag' + handle = "smoother_lag" call parse(handle, dim_lag) !kuw end diff --git a/interface/framework/l2g_state_pdaf.F90 b/interface/framework/l2g_state_pdaf.F90 index 469370d0..63c10e5e 100644 --- a/interface/framework/l2g_state_pdaf.F90 +++ b/interface/framework/l2g_state_pdaf.F90 @@ -85,7 +85,7 @@ SUBROUTINE l2g_state_pdaf(step, domain_p, dim_l, state_l, dim_p, state_p) DO i = 0, dim_l-1 nshift_p = domain_p + i * n_domain state_p(nshift_p) = state_l(i+1) - ENDDO + END DO else if (model == tag_model_clm) then state_p(domain_p) = state_l(dim_l) end if diff --git a/interface/framework/localize_covar_pdaf.F90 b/interface/framework/localize_covar_pdaf.F90 index b0865fb8..155b8ee4 100644 --- a/interface/framework/localize_covar_pdaf.F90 +++ b/interface/framework/localize_covar_pdaf.F90 @@ -112,17 +112,17 @@ SUBROUTINE localize_covar_pdaf(dim_p, dim_obs, HP, HPH) tmp(1,1) = 1.0 ! Screen output - WRITE (*,'(8x, a)') & - '--- Apply covariance localization' - WRITE (*, '(12x, a, 1x, f12.2)') & - '--- Local influence radius', cradius + WRITE (*,"(8x, a)") & + "--- Apply covariance localization" + WRITE (*, "(12x, a, 1x, f12.2)") & + "--- Local influence radius", cradius IF (locweight == 1) THEN - WRITE (*, '(12x, a)') & - '--- Use exponential distance-dependent weight' + WRITE (*, "(12x, a)") & + "--- Use exponential distance-dependent weight" ELSE IF (locweight == 2) THEN - WRITE (*, '(12x, a)') & - '--- Use distance-dependent weight by 5th-order polynomial' + WRITE (*, "(12x, a)") & + "--- Use distance-dependent weight by 5th-order polynomial" END IF ! Set parameters for weight calculation @@ -196,7 +196,7 @@ SUBROUTINE localize_covar_pdaf(dim_p, dim_obs, HP, HPH) END DO END DO - ENDIF ! model==tag_model_parflow + END IF ! model==tag_model_parflow #endif !by hcp to computer the localized covariance matrix in CLMSA case @@ -312,7 +312,7 @@ SUBROUTINE localize_covar_pdaf(dim_p, dim_obs, HP, HPH) if(allocated(clmobs_lon))deallocate(clmobs_lon) if(allocated(clmobs_lat))deallocate(clmobs_lat) - ENDIF ! model==tag_model_clm + END IF ! model==tag_model_clm #endif !hcp end diff --git a/interface/framework/mod_parallel_pdaf.F90 b/interface/framework/mod_parallel_pdaf.F90 index f7160aa2..ca089020 100644 --- a/interface/framework/mod_parallel_pdaf.F90 +++ b/interface/framework/mod_parallel_pdaf.F90 @@ -83,7 +83,7 @@ MODULE mod_parallel_pdaf !EOP INTERFACE - SUBROUTINE read_enkfpar(parname) BIND(C, name='read_enkfpar') + SUBROUTINE read_enkfpar(parname) BIND(C, name="read_enkfpar") ! USE iso_c_binding IMPLICIT NONE CHARACTER(LEN=*), INTENT(in) :: parname diff --git a/interface/framework/mod_read_obs.F90 b/interface/framework/mod_read_obs.F90 index 46c0d0f9..d257cf14 100755 --- a/interface/framework/mod_read_obs.F90 +++ b/interface/framework/mod_read_obs.F90 @@ -442,7 +442,7 @@ subroutine read_obs_nc(current_observation_filename) if (screen > 2) then print *, "TSMP-PDAF mype(w)=", mype_world, ": pressure_obserr=", pressure_obserr end if - endif + end if !has_depth = nf90_inq_varid(ncid, depth_name, depth_varid) !if(has_depth == nf90_noerr) then @@ -483,7 +483,7 @@ subroutine read_obs_nc(current_observation_filename) ! write(*,*) 'For crns average mode parflow obs layer iz must be 1' ! stop !endif - endif + end if !end hcp if (screen > 2) then print *, "TSMP-PDAF mype(w)=", mype_world, ": z_idx_obs_nc=", z_idx_obs_nc @@ -539,7 +539,7 @@ subroutine read_obs_nc(current_observation_filename) if (screen > 2) then print *, "TSMP-PDAF mype(w)=", mype_world, ": clm_obserr=", clm_obserr end if - endif + end if ! Read the longitude latidute data from the file. @@ -620,7 +620,7 @@ end subroutine read_obs_nc !> - `yidx_obs` !> - `zidx_obs` !> - `ind_obs` - subroutine get_obsindex_currentobsfile(no_obs) bind(c,name='get_obsindex_currentobsfile') + subroutine get_obsindex_currentobsfile(no_obs) bind(c,name="get_obsindex_currentobsfile") USE mod_tsmp, ONLY: tcycle USE mod_assimilation, only: obs_filename use netcdf, only: nf90_max_name @@ -646,7 +646,7 @@ subroutine get_obsindex_currentobsfile(no_obs) bind(c,name='get_obsindex_current integer :: dimid, status integer :: haserr - write(filename, '(a, i5.5)') trim(obs_filename)//'.', tcycle + write(filename, "(a, i5.5)") trim(obs_filename)//".", tcycle if(allocated(idx_obs_pf)) deallocate(idx_obs_pf) if(allocated(x_idx_obs_pf)) deallocate(x_idx_obs_pf) @@ -727,7 +727,7 @@ end subroutine clean_obs_nc !> subroutine `get_obsindex_currentobsfile`. !> !> Only used in `enkf_parflow.c` with `pf_gwmasking=2`. - subroutine clean_obs_pf() bind(c,name='clean_obs_pf') + subroutine clean_obs_pf() bind(c,name="clean_obs_pf") implicit none if(allocated(idx_obs_pf))deallocate(idx_obs_pf) if(allocated(x_idx_obs_pf))deallocate(x_idx_obs_pf) @@ -932,7 +932,7 @@ subroutine check_n_observationfile_next_type(fn, obs_type_str) if(allocated(obs_type_lok)) deallocate(obs_type_lok) allocate(obs_type_lok(dim_obs)) - obs_type_str = '' + obs_type_str = "" status = nf90_inq_varid(ncid, "type_clm", obstype_varid) if (status == nf90_noerr) then @@ -962,13 +962,13 @@ subroutine update_obs_type(obs_type_str) character(len=*), intent(in) :: obs_type_str select case (trim(adjustl(obs_type_str))) - case ('GRACE') + case ("GRACE") clmupdate_tws = 1 clmupdate_swc = 0 clmupdate_T = 0 clmupdate_texture = 0 - case ('SM') + case ("SM") clmupdate_tws = 0 clmupdate_swc = 1 clmupdate_T = 0 @@ -982,7 +982,7 @@ subroutine update_obs_type(obs_type_str) ! clmupdate_C = 1 case default - write(*,*) 'ERROR: Unknown obs_type_str in update_obs_type:', trim(obs_type_str) + write(*,*) "ERROR: Unknown obs_type_str in update_obs_type:", trim(obs_type_str) call abort_parallel() end select end subroutine update_obs_type diff --git a/interface/framework/next_observation_pdaf.F90 b/interface/framework/next_observation_pdaf.F90 index d22c80fa..7f246c4d 100644 --- a/interface/framework/next_observation_pdaf.F90 +++ b/interface/framework/next_observation_pdaf.F90 @@ -113,7 +113,7 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) !nsteps = 0 if (mype_world==0 .and. screen > 2) then - write(*,*) 'TSMP-PDAF (in next_observation_pdaf.F90) total_steps: ',total_steps + write(*,*) "TSMP-PDAF (in next_observation_pdaf.F90) total_steps: ",total_steps end if do @@ -127,7 +127,7 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) end if ! Check observation file #counter for observations - write(fn, '(a, i5.5)') trim(obs_filename)//'.', counter + write(fn, "(a, i5.5)") trim(obs_filename)//".", counter call check_n_observationfile(fn,no_obs) ! Exit loop if observation file contains observations @@ -146,17 +146,17 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) #ifdef PDAF_DEBUG ! Error Check: delt_obs must be one for flexible time stepping if (delt_obs /= 1) then - write(*,'(a,i10)') "delt_obs = ", delt_obs - write(*,'(a)') "delt_obs must be one for flexible time stepping" + write(*,"(a,i10)") "delt_obs = ", delt_obs + write(*,"(a)") "delt_obs must be one for flexible time stepping" stop "Stopped from incorrect delt_obs" end if ! Warning: nsteps should be one if(nsteps > 1) then - write(*,'(a,i10)') "WARNING: nsteps = ", nsteps - write(*,'(a)') "WARNING: nsteps should be one for flexible time stepping" - write(*,'(a)') "WARNING: Any time differences can be encoded in observation files" - write(*,'(a)') "WARNING: using the variable da_interval." + write(*,"(a,i10)") "WARNING: nsteps = ", nsteps + write(*,"(a)") "WARNING: nsteps should be one for flexible time stepping" + write(*,"(a)") "WARNING: Any time differences can be encoded in observation files" + write(*,"(a)") "WARNING: using the variable da_interval." end if #endif @@ -174,8 +174,8 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) #ifdef PDAF_DEBUG ! Error Check: da_interval_new should be set to at least one if(da_interval_new < 1.0) then - write(*,'(a,es22.15)') "da_interval_new = ", da_interval_new - write(*,'(a)') "da_interval_new is too small, should be minimum of one" + write(*,"(a,es22.15)") "da_interval_new = ", da_interval_new + write(*,"(a)") "da_interval_new is too small, should be minimum of one" stop "Stopped from incorrect da_interval_new" end if #endif @@ -184,14 +184,14 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) da_interval = da_interval_new if (mype_world==0 .and. screen > 2) then - write(*,'(a,es22.15)')'TSMP-PDAF (next_observation_pdaf.F90) da_interval: ', da_interval + write(*,"(a,es22.15)")"TSMP-PDAF (next_observation_pdaf.F90) da_interval: ", da_interval end if end if if (mype_world==0 .and. screen > 2) then - write(*,*)'TSMP-PDAF (next_observation_pdaf.F90) stepnow: ',stepnow - write(*,*)'TSMP-PDAF (next_observation_pdaf.F90) no_obs, nsteps, counter: ',no_obs,nsteps,counter + write(*,*)"TSMP-PDAF (next_observation_pdaf.F90) stepnow: ",stepnow + write(*,*)"TSMP-PDAF (next_observation_pdaf.F90) no_obs, nsteps, counter: ",no_obs,nsteps,counter end if !kuw end @@ -231,38 +231,38 @@ SUBROUTINE next_observation_pdaf(stepnow, nsteps, doexit, time) if (clmupdate_tws/=0) then ! only update set_zero when GRACE is assimilated at the current time step nstep = get_nstep() if (stepnow/=toffset) then - write(fn, '(a, i5.5)') trim(obs_filename)//'.', stepnow + write(fn, "(a, i5.5)") trim(obs_filename)//".", stepnow call check_n_observationfile_set_zero(fn, set_averaging_to_zero) if (set_averaging_to_zero/=ispval) then set_averaging_to_zero = set_averaging_to_zero+nstep end if if (mype_world==0 .and. screen > 2) then - write(*,*) 'set_averaging_to_zero (in next_observation_pdaf):',set_averaging_to_zero + write(*,*) "set_averaging_to_zero (in next_observation_pdaf):",set_averaging_to_zero end if end if end if ! update observation type with next file - write(fn, '(a, i5.5)') trim(obs_filename)//'.', stepnow + delt_obs + write(fn, "(a, i5.5)") trim(obs_filename)//".", stepnow + delt_obs if (mype_world==0 .and. screen > 2) then - write(*,*)'next_observation_pdaf: fn = ', fn - write(*,*)'Call check_n_observationfile_next_type' + write(*,*)"next_observation_pdaf: fn = ", fn + write(*,*)"Call check_n_observationfile_next_type" end if inquire(file=fn, exist=file_exists) if (.not. file_exists) then if (mype_world == 0 .and. screen > 2) then - write(*,*) 'next_observation_pdaf: skipping setting next observation type as no next file available' + write(*,*) "next_observation_pdaf: skipping setting next observation type as no next file available" end if else call check_n_observationfile_next_type(fn, obs_type_str) - if (trim(obs_type_str) /= '') then + if (trim(obs_type_str) /= "") then call update_obs_type(obs_type_str) end if if (mype_world==0 .and. screen > 2) then - write(*,*)'next_type (in next_observation_pdaf):',trim(obs_type_str) + write(*,*)"next_type (in next_observation_pdaf):",trim(obs_type_str) end if end if diff --git a/interface/framework/obs_GRACE_pdafomi.F90 b/interface/framework/obs_GRACE_pdafomi.F90 index 149a4581..657c7def 100644 --- a/interface/framework/obs_GRACE_pdafomi.F90 +++ b/interface/framework/obs_GRACE_pdafomi.F90 @@ -262,8 +262,9 @@ SUBROUTINE init_dim_obs_GRACE(step, dim_obs) ! ********************************************* !IF (mype_filter==0) & - IF (mype_filter==0) & - WRITE (*,*) 'Assimilate observations - obs type GRACE' + IF (mype_filter==0) then + WRITE (*,*) "Assimilate observations - obs type GRACE" + end if ! Store whether to assimilate this observation type (used in routines below) @@ -288,25 +289,25 @@ SUBROUTINE init_dim_obs_GRACE(step, dim_obs) ! ...; dependent on what you want to implement) - obs_type_name = 'GRACE' + obs_type_name = "GRACE" ! now call function to get observations if (mype_filter==0 .and. screen > 2) then - write(*,*)'load observations from type GRACE' + write(*,*)"load observations from type GRACE" end if - write(current_observation_filename, '(a, i5.5)') trim(obs_filename)//'.', step + write(current_observation_filename, "(a, i5.5)") trim(obs_filename)//".", step call read_obs_nc_type(current_observation_filename, obs_type_name, & dim_obs, obs_g, lon_obs, lat_obs, layer_obs, & dr_obs, obserr, clm_obscov) if (mype_filter==0 .and. screen > 2) then - write(*,*)'Done: load observations from type GRACE' + write(*,*)"Done: load observations from type GRACE" end if if (dim_obs == 0) then if (mype_filter==0 .and. screen > 2) then - write(*,*)'TSMP-PDAF mype(w) =', mype_world, & - ': No observations of type GRACE found in file ', & + write(*,*)"TSMP-PDAF mype(w) =", mype_world, & + ": No observations of type GRACE found in file ", & trim(current_observation_filename) end if dim_obs_p = 0 @@ -852,7 +853,7 @@ SUBROUTINE obs_op_GRACE(dim_p, dim_obs, state_p, ostate) CALL PDAFomi_gather_obsstate(thisobs, ostate_p, ostate) deallocate(ostate_p) if (screen>2 .and. mype_filter==0 .and. thisobs%dim_obs_f>0) then - write(*,*)'m_state_sum_global = ', m_state_sum_global + write(*,*)"m_state_sum_global = ", m_state_sum_global end if END SUBROUTINE obs_op_GRACE @@ -1108,8 +1109,8 @@ subroutine init_obscovar_GRACE(step, dim_obs, dim_obs_p, covar, m_state_p, isdia DO i = id_start(pe), id_end(pe) covar(i, i) = covar(i, i) + 1.0/thisobs%ivar_obs_f(cnt) cnt = cnt + 1 - ENDDO - ENDDO + END DO + END DO ! The matrix is diagonal ! This setting avoids the computation of the SVD of COVAR @@ -1248,26 +1249,26 @@ subroutine prodRinvA_l_GRACE(domain_p, step, dim_obs, rank, obs_l, A_l, C_l) ! Screen output IF (verbose == 1) THEN - WRITE (*, '(8x, a, f12.3)') & - '--- Use global rms for observations of ', rms_obs_GRACE - WRITE (*, '(8x, a, 1x)') & - '--- Domain localization' - WRITE (*, '(12x, a, 1x, f12.2)') & - '--- Local influence radius', cradius_GRACE + WRITE (*, "(8x, a, f12.3)") & + "--- Use global rms for observations of ", rms_obs_GRACE + WRITE (*, "(8x, a, 1x)") & + "--- Domain localization" + WRITE (*, "(12x, a, 1x, f12.2)") & + "--- Local influence radius", cradius_GRACE IF (locweight > 0) THEN - WRITE (*, '(12x, a)') & - '--- Use distance-dependent weight for observation errors' + WRITE (*, "(12x, a)") & + "--- Use distance-dependent weight for observation errors" IF (locweight == 3) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with mean error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with mean error variance" ELSE IF (locweight == 4) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with single-point error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with single-point error variance" END IF END IF - ENDIF + END IF ALLOCATE(weight(thisobs_l%dim_obs_l)) call PDAFomi_observation_localization_weights(thisobs_l, thisobs, rank, A_l, & @@ -1398,7 +1399,7 @@ subroutine deallocate_obs_GRACE() implicit none if (mype_filter==0) then - WRITE (*,*) 'Deallocating observations type GRACE' + WRITE (*,*) "Deallocating observations type GRACE" end if call PDAFomi_deallocate_obs(thisobs) diff --git a/interface/framework/obs_SM_pdafomi.F90 b/interface/framework/obs_SM_pdafomi.F90 index 7cc57dc9..e6c10b81 100644 --- a/interface/framework/obs_SM_pdafomi.F90 +++ b/interface/framework/obs_SM_pdafomi.F90 @@ -274,8 +274,9 @@ SUBROUTINE init_dim_obs_SM(step, dim_obs) ! *** Initialize full observation dimension *** ! ********************************************* - IF (mype_filter==0) & - WRITE (*,*) 'Assimilate observations - obs type soil moisture' + IF (mype_filter==0) then + WRITE (*,*) "Assimilate observations - obs type soil moisture" + end if ! Store whether to assimilate this observation type (used in routines below) @@ -294,14 +295,14 @@ SUBROUTINE init_dim_obs_SM(step, dim_obs) ! ********************************** - obs_type_name = 'SM' + obs_type_name = "SM" ! now call function to get observations if (mype_filter==0 .and. screen > 2) then - write(*,*)'load observations from type SM' + write(*,*)"load observations from type SM" end if - write(current_observation_filename, '(a, i5.5)') trim(obs_filename)//'.', step + write(current_observation_filename, "(a, i5.5)") trim(obs_filename)//".", step if (mype_filter == 0) then @@ -316,8 +317,8 @@ SUBROUTINE init_dim_obs_SM(step, dim_obs) if (dim_obs == 0) then if (mype_filter==0 .and. screen > 2) then - write(*,*)'TSMP-PDAF mype(w) =', mype_world, & - ': No observations of type SM found in file ', & + write(*,*)"TSMP-PDAF mype(w) =", mype_world, & + ": No observations of type SM found in file ", & trim(current_observation_filename) end if dim_obs_p = 0 @@ -368,7 +369,7 @@ SUBROUTINE init_dim_obs_SM(step, dim_obs) if (mype_filter==0 .and. screen > 2) then - write(*,*)'Done: load observations from type SM' + write(*,*)"Done: load observations from type SM" end if @@ -1253,8 +1254,8 @@ subroutine init_obscovar_SM(step, dim_obs, dim_obs_p, covar, m_state_p, isdiag) ! process, we also can just take index cnt instead of ! complicated mapping between nc and pdaf indices cnt = cnt + 1 - ENDDO - ENDDO + END DO + END DO ! The matrix is diagonal ! This setting avoids the computation of the SVD of COVAR @@ -1337,26 +1338,26 @@ subroutine prodRinvA_l_SM(domain_p, step, dim_obs, rank, obs_l, A_l, C_l) ! Screen output IF (verbose == 1) THEN - WRITE (*, '(8x, a, f12.3)') & - '--- Use global rms for observations of ', rms_obs_SM - WRITE (*, '(8x, a, 1x)') & - '--- Domain localization' - WRITE (*, '(12x, a, 1x, f12.2)') & - '--- Local influence radius', cradius_SM + WRITE (*, "(8x, a, f12.3)") & + "--- Use global rms for observations of ", rms_obs_SM + WRITE (*, "(8x, a, 1x)") & + "--- Domain localization" + WRITE (*, "(12x, a, 1x, f12.2)") & + "--- Local influence radius", cradius_SM IF (locweight > 0) THEN - WRITE (*, '(12x, a)') & - '--- Use distance-dependent weight for observation errors' + WRITE (*, "(12x, a)") & + "--- Use distance-dependent weight for observation errors" IF (locweight == 3) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with mean error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with mean error variance" ELSE IF (locweight == 4) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with single-point error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with single-point error variance" END IF END IF - ENDIF + END IF ALLOCATE(weight(thisobs_l%dim_obs_l)) call PDAFomi_observation_localization_weights(thisobs_l, thisobs, rank, A_l, & @@ -1380,7 +1381,7 @@ subroutine deallocate_obs_SM() implicit none if (mype_filter==0) then - WRITE (*,*) 'Deallocating observations type SM' + WRITE (*,*) "Deallocating observations type SM" end if call PDAFomi_deallocate_obs(thisobs) diff --git a/interface/framework/obs_op_pdaf.F90 b/interface/framework/obs_op_pdaf.F90 index 1ce5db81..bfd08a43 100644 --- a/interface/framework/obs_op_pdaf.F90 +++ b/interface/framework/obs_op_pdaf.F90 @@ -151,7 +151,7 @@ SUBROUTINE obs_op_pdaf(step, dim_p, dim_obs_p, state_p, m_state_p) ! write(*,*) 'model LST', m_state_p(:) ! write(*,*) 'TG', state_p(obs_index_p(:)) ! write(*,*) 'TV', state_p(clm_varsize+obs_index_p(:)) -endif +end if #endif @@ -165,14 +165,14 @@ SUBROUTINE obs_op_pdaf(step, dim_p, dim_obs_p, state_p, m_state_p) soide(0)=0.d0 do i=1,nz_glob soide(i)=soide(i-1)+soilay_fortran(nz_glob-i+1) - enddo + end do do i = 1, dim_obs_p !Initial average soil moisture for 1st iteration avesm=0.d0 do j=1,nz_glob avesm=avesm+(soide(j)-soide(j-1))*state_p(sc_p(j,i))/soide(nz_glob) - enddo + end do avesm_temp=0.d0 !iteration @@ -186,12 +186,12 @@ SUBROUTINE obs_op_pdaf(step, dim_p, dim_obs_p, state_p, m_state_p) do j=1,nz_glob if ((soide(j-1) 680) then z = 8 - ELSEIF (j < 680 .and. j > 480) then + ELSE IF (j < 680 .and. j > 480) then z = 7 - ELSEIF (j < 480 .and. j > 320) then + ELSE IF (j < 480 .and. j > 320) then z = 6 - ELSEIF (j < 320 .and. j > 200) then + ELSE IF (j < 320 .and. j > 200) then z = 5 - ELSEIF (j < 200 .and. j > 120) then + ELSE IF (j < 200 .and. j > 120) then z = 4 - ELSEIF (j < 120 .and. j > 60) then + ELSE IF (j < 120 .and. j > 60) then z = 3 - ELSEIF (j < 60 .and. j > 20) then + ELSE IF (j < 60 .and. j > 20) then z = 2 - ELSEIF (j < 20) then + ELSE IF (j < 20) then z = 1 - ENDIF + END IF weights_layer(z) = weights_layer(z) + weights_r1(j) + weights_r2(j) + weights_r3(j) nweights(z) = nweights(z) + 1 END DO @@ -312,9 +312,9 @@ SUBROUTINE obs_op_pdaf(step, dim_p, dim_obs_p, state_p, m_state_p) m_state_p(i) = 0 do icorner = 1, 4 m_state_p(i) = m_state_p(i) + state_p(obs_interp_indices_p(i,icorner)) * obs_interp_weights_p(i,icorner) - enddo + end do - enddo + end do end if diff --git a/interface/framework/parser_mpi.F90 b/interface/framework/parser_mpi.F90 index 59699c39..8f531074 100644 --- a/interface/framework/parser_mpi.F90 +++ b/interface/framework/parser_mpi.F90 @@ -125,12 +125,12 @@ SUBROUTINE parse_int(handle, intvalue) ! *** Initialization *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) - string = '-' // TRIM(handle) + string = "-" // TRIM(handle) modified = .FALSE. ! *** Parsing *** #ifdef F77 - write (*,*) 'PARSE for F77!!!!!!!!!!!!!!!' + write (*,*) "PARSE for F77!!!!!!!!!!!!!!!" IF (iargc() > 0) THEN DO i = 1, iargc() - 1 CALL getarg(i, str1) @@ -139,8 +139,8 @@ SUBROUTINE parse_int(handle, intvalue) READ(str2, *) parsed_int modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 @@ -150,16 +150,16 @@ SUBROUTINE parse_int(handle, intvalue) READ(str2, *) parsed_int modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #endif ! *** Finalize *** IF (modified) THEN intvalue = parsed_int ! IF (mype == 0) WRITE (*, '(2x, a, a, a, i)') & - IF (mype == 0) WRITE (*, '(2x, a, a, a, i10)') & - 'PARSER: ', TRIM(handle), '=', parsed_int + IF (mype == 0) WRITE (*, "(2x, a, a, a, i10)") & + "PARSER: ", TRIM(handle), "=", parsed_int END IF END SUBROUTINE parse_int @@ -180,7 +180,7 @@ SUBROUTINE parse_real(handle, realvalue) ! *** Initialize *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) - string = '-' // TRIM(handle) + string = "-" // TRIM(handle) modified = .FALSE. ! *** Parsing *** @@ -193,8 +193,8 @@ SUBROUTINE parse_real(handle, realvalue) READ(str2, *) parsed_real modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 @@ -204,15 +204,15 @@ SUBROUTINE parse_real(handle, realvalue) READ(str2, *) parsed_real modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #endif ! *** Finalize *** IF (modified) THEN realvalue = parsed_real - IF (mype == 0) WRITE (*, '(2x, a, a, a, es12.4)') & - 'PARSER: ', TRIM(handle), '=', parsed_real + IF (mype == 0) WRITE (*, "(2x, a, a, a, es12.4)") & + "PARSER: ", TRIM(handle), "=", parsed_real END IF END SUBROUTINE parse_real @@ -236,7 +236,7 @@ SUBROUTINE parse_string(handle, charvalue) ! *** Initialize *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) - string = '-' // TRIM(handle) + string = "-" // TRIM(handle) modified = .FALSE. ! *** Parsing *** @@ -248,11 +248,11 @@ SUBROUTINE parse_string(handle, charvalue) IF (str1 == TRIM(string)) THEN ! Format specifier is needed for reading paths. Using ! `*` as format specifier, reading stops at a `/` - READ(str2, '(a)') parsed_string + READ(str2, "(a)") parsed_string modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 @@ -265,10 +265,10 @@ SUBROUTINE parse_string(handle, charvalue) CALL get_command_argument(i+1, str2_check) IF (mype == 0) THEN IF (.NOT. TRIM(str2_check) == TRIM(str2)) THEN - WRITE (*,'(2x, a)') "PARSER: ERROR, command line input too long." - WRITE (*,'(2x, a, 1x, a)') "called handle=", TRIM(string) - WRITE (*,'(2x, a, 1x, a)') "parsed handle=", TRIM(str1) - WRITE (*,'(2x, a, 1x, a)') "parsed input(cut)=", TRIM(str2) + WRITE (*,"(2x, a)") "PARSER: ERROR, command line input too long." + WRITE (*,"(2x, a, 1x, a)") "called handle=", TRIM(string) + WRITE (*,"(2x, a, 1x, a)") "parsed handle=", TRIM(str1) + WRITE (*,"(2x, a, 1x, a)") "parsed input(cut)=", TRIM(str2) call abort_parallel() END IF END IF @@ -277,18 +277,18 @@ SUBROUTINE parse_string(handle, charvalue) IF (str1 == TRIM(string)) THEN ! Format specifier is needed for reading paths. Using ! `*` as format specifier, reading stops at a `/` - READ(str2, '(a)') parsed_string + READ(str2, "(a)") parsed_string modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #endif ! *** Finalize *** IF (modified) THEN charvalue = parsed_string - IF (mype == 0) WRITE (*, '(2x, a, a, a, a)') & - 'PARSER: ', TRIM(handle), '= ', TRIM(parsed_string) + IF (mype == 0) WRITE (*, "(2x, a, a, a, a)") & + "PARSER: ", TRIM(handle), "= ", TRIM(parsed_string) END IF END SUBROUTINE parse_string @@ -310,7 +310,7 @@ SUBROUTINE parse_logical(handle, logvalue) ! *** Initialization *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) - string = '-' // TRIM(handle) + string = "-" // TRIM(handle) modified = .FALSE. ! *** Parsing *** @@ -323,8 +323,8 @@ SUBROUTINE parse_logical(handle, logvalue) READ(str2, *) parsed_log modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 @@ -334,15 +334,15 @@ SUBROUTINE parse_logical(handle, logvalue) READ(str2, *) parsed_log modified = .TRUE. END IF - ENDDO - ENDIF + END DO + END IF #endif ! *** Finalize *** IF (modified) THEN logvalue = parsed_log - IF (mype == 0) WRITE (*, '(2x, a, a, a, l1)') & - 'PARSER: ', TRIM(handle), '=', parsed_log + IF (mype == 0) WRITE (*, "(2x, a, a, a, l1)") & + "PARSER: ", TRIM(handle), "=", parsed_log END IF END SUBROUTINE parse_logical diff --git a/interface/framework/pdaf_terrsysmp.F90 b/interface/framework/pdaf_terrsysmp.F90 index 9ff9052a..7721ebac 100644 --- a/interface/framework/pdaf_terrsysmp.F90 +++ b/interface/framework/pdaf_terrsysmp.F90 @@ -83,7 +83,7 @@ PROGRAM pdaf_terrsysmp IF (mype_world > -1 .AND. screen > 2) THEN PRINT *, "TSMP-PDAF mype(w)=", mype_world, ": time loop", tcycle - ENDIF + END IF ! forward simulation of component models CALL integrate_tsmp() @@ -98,7 +98,7 @@ PROGRAM pdaf_terrsysmp !call MPI_BARRIER(MPI_COMM_WORLD, MPIerr) !print *,"Finished complete assimilation cycle", tcycle - ENDDO + END DO ! barrier after model integrations !call MPI_BARRIER(MPI_COMM_WORLD, MPIerr) diff --git a/interface/framework/prepoststep_ens_pdaf.F90 b/interface/framework/prepoststep_ens_pdaf.F90 index 7ae7fac0..0c8b97ba 100644 --- a/interface/framework/prepoststep_ens_pdaf.F90 +++ b/interface/framework/prepoststep_ens_pdaf.F90 @@ -137,15 +137,15 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & if (2 == 1) then IF (mype_filter == 0) THEN IF (firsttime) THEN - WRITE (*, '(8x, a)') 'Analize initial state ensemble' - anastr = 'ini' + WRITE (*, "(8x, a)") "Analize initial state ensemble" + anastr = "ini" ELSE IF (step<0) THEN - WRITE (*, '(8x, a)') 'Analize and write forecasted state ensemble' - anastr = 'for' + WRITE (*, "(8x, a)") "Analize and write forecasted state ensemble" + anastr = "for" ELSE - WRITE (*, '(8x, a)') 'Analize and write assimilated state ensemble' - anastr = 'ana' + WRITE (*, "(8x, a)") "Analize and write assimilated state ensemble" + anastr = "ana" END IF END IF END IF @@ -168,7 +168,7 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & ! ************************************************************** ! *** Compute mean state - IF (mype_filter == 0) WRITE (*, '(8x, a)') '--- compute ensemble mean' + IF (mype_filter == 0) WRITE (*, "(8x, a)") "--- compute ensemble mean" ! state_p = 0.0 state_p = 0.0 @@ -195,7 +195,7 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & ! *** Assemble global variance vector on filter PE 0 *** ! ****************************************************** - WRITE (*,*) 'TEMPLATE prepoststep_ens_pdaf.F90: Initialize variance, either directly or with MPI' + WRITE (*,*) "TEMPLATE prepoststep_ens_pdaf.F90: Initialize variance, either directly or with MPI" if (filterpe) then call MPI_Barrier(comm_filter, ierror) end if @@ -210,7 +210,7 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & end do #ifdef PDAF_DEBUG ! Debug output: summed until index local state dimension array - if (mype_model == 0 ) WRITE(*, '(a,x,a,i5,x,a,x,i9)') "TSMP-PDAF-debug", "mype(w)=", mype_world, & + if (mype_model == 0 ) WRITE(*, "(a,x,a,i5,x,a,x,i9)") "TSMP-PDAF-debug", "mype(w)=", mype_world, & "init_pdaf: dim_state_p_stride in modified:", dim_state_p_stride #endif @@ -240,7 +240,7 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & IF (mype_filter == 0) THEN DO i = 1, dim_state rmserror_est = rmserror_est + variance(i) - ENDDO + END DO rmserror_est = SQRT(rmserror_est / dim_state) END IF DEALLOCATE(variance) @@ -253,8 +253,8 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & ! Output RMS errors given by sampled covar matrix ! if (model == tag_model_parflow) then IF (mype_filter == 0) THEN - WRITE (*, '(12x, a, es12.4)') & - 'RMS error according to sampled variance: ', rmserror_est + WRITE (*, "(12x, a, es12.4)") & + "RMS error according to sampled variance: ", rmserror_est END IF ! end if @@ -262,7 +262,7 @@ SUBROUTINE prepoststep_ens_pdaf(step, dim_p, dim_ens, dim_ens_p, dim_obs_p, & ! *** File output *** ! ******************* notfirst: IF (.not. firsttime) THEN - WRITE (*,*) 'TEMPLATE prepoststep_ens_pdaf.F90: Implement writing of output files here!' + WRITE (*,*) "TEMPLATE prepoststep_ens_pdaf.F90: Implement writing of output files here!" END IF notfirst diff --git a/interface/framework/prodrinva_l_pdaf.F90 b/interface/framework/prodrinva_l_pdaf.F90 index 9fa0e456..afac1300 100644 --- a/interface/framework/prodrinva_l_pdaf.F90 +++ b/interface/framework/prodrinva_l_pdaf.F90 @@ -110,26 +110,26 @@ SUBROUTINE prodRinvA_l_pdaf(domain_p, step, dim_obs_l, rank, obs_l, A_l, C_l) ! Screen output IF (verbose == 1) THEN - WRITE (*, '(8x, a, f12.3)') & - '--- Use global rms for observations of ', rms_obs - WRITE (*, '(8x, a, 1x)') & - '--- Domain localization' - WRITE (*, '(12x, a, 1x, f12.2)') & - '--- Local influence radius', cradius + WRITE (*, "(8x, a, f12.3)") & + "--- Use global rms for observations of ", rms_obs + WRITE (*, "(8x, a, 1x)") & + "--- Domain localization" + WRITE (*, "(12x, a, 1x, f12.2)") & + "--- Local influence radius", cradius IF (locweight > 0) THEN - WRITE (*, '(12x, a)') & - '--- Use distance-dependent weight for observation errors' + WRITE (*, "(12x, a)") & + "--- Use distance-dependent weight for observation errors" IF (locweight == 3) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with mean error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with mean error variance" ELSE IF (locweight == 4) THEN - write (*, '(12x, a)') & - '--- Use regulated weight with single-point error variance' + write (*, "(12x, a)") & + "--- Use regulated weight with single-point error variance" END IF END IF - ENDIF + END IF ! *** initialize numbers (this is for constant observation errors) ! Set observation variance and inverse here diff --git a/interface/framework/prodrinva_pdaf.F90 b/interface/framework/prodrinva_pdaf.F90 index f6a7be17..2b675512 100644 --- a/interface/framework/prodrinva_pdaf.F90 +++ b/interface/framework/prodrinva_pdaf.F90 @@ -78,7 +78,7 @@ SUBROUTINE prodRinvA_pdaf(step, dim_obs_p, rank_dim_ens, obs_p, A_p, C_p) ! *** INITIALIZATION *** ! ********************** - WRITE (*,*) 'TEMPLATE prodrinva_pdaf.F90: Implement multiplication here!' + WRITE (*,*) "TEMPLATE prodrinva_pdaf.F90: Implement multiplication here!" ! *** initialize numbers ivariance_obs = 1.0 / rms_obs ** 2 diff --git a/interface/model/eclm/enkf_clm_5.F90 b/interface/model/eclm/enkf_clm_5.F90 index dd7b43a8..b383c28b 100644 --- a/interface/model/eclm/enkf_clm_5.F90 +++ b/interface/model/eclm/enkf_clm_5.F90 @@ -126,16 +126,16 @@ subroutine clm_init(finname, pdaf_id, pdaf_max, mype) bind(C,name="clm_init") select case(esmf_logfile_option) - case('ESMF_LOGKIND_SINGLE') + case("ESMF_LOGKIND_SINGLE") esmf_logfile_kind = ESMF_LOGKIND_SINGLE - case('ESMF_LOGKIND_MULTI') + case("ESMF_LOGKIND_MULTI") esmf_logfile_kind = ESMF_LOGKIND_MULTI - case('ESMF_LOGKIND_MULTI_ON_ERROR') + case("ESMF_LOGKIND_MULTI_ON_ERROR") esmf_logfile_kind = ESMF_LOGKIND_MULTI_ON_ERROR - case('ESMF_LOGKIND_NONE') + case("ESMF_LOGKIND_NONE") esmf_logfile_kind = ESMF_LOGKIND_NONE case default - call shr_sys_abort('CIME ERROR: invalid ESMF logfile kind '//trim(esmf_logfile_option)) + call shr_sys_abort("CIME ERROR: invalid ESMF logfile kind "//trim(esmf_logfile_option)) end select !!>> TSMP PDAF addition beginning write(6,*) "esmf_initialize" @@ -167,22 +167,22 @@ subroutine clm_init(finname, pdaf_id, pdaf_max, mype) bind(C,name="clm_init") ! Call the initialize, run and finalize routines. !-------------------------------------------------------------------------- - call t_startf('CPL:INIT') + call t_startf("CPL:INIT") call t_adj_detailf(+1) - call t_startstop_valsf('CPL:cime_pre_init1', walltime=cime_pre_init1_time) - call t_startstop_valsf('CPL:ESMF_Initialize', walltime=ESMF_Initialize_time) - call t_startstop_valsf('CPL:cime_pre_init2', walltime=cime_pre_init2_time) + call t_startstop_valsf("CPL:cime_pre_init1", walltime=cime_pre_init1_time) + call t_startstop_valsf("CPL:ESMF_Initialize", walltime=ESMF_Initialize_time) + call t_startstop_valsf("CPL:cime_pre_init2", walltime=cime_pre_init2_time) call cime_init() call t_adj_detailf(-1) - call t_stopf('CPL:INIT') + call t_stopf("CPL:INIT") cime_init_time_adjustment = cime_pre_init1_time & + ESMF_Initialize_time & + cime_pre_init2_time - call t_startstop_valsf('CPL:INIT', walltime=cime_init_time_adjustment, & + call t_startstop_valsf("CPL:INIT", walltime=cime_init_time_adjustment, & callcount=0) #if defined CLMSA diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index bc2e4c59..5fe6d272 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -236,7 +236,7 @@ subroutine define_clm_statevec(mype) #ifdef PDAF_DEBUG ! Debug output of clm_statevecsize - WRITE(*, '(a,x,a,i5,x,a,i10)') "TSMP-PDAF-debug", "mype(w)=", mype, "define_clm_statevec: clm_statevecsize=", clm_statevecsize + WRITE(*, "(a,x,a,i5,x,a,i10)") "TSMP-PDAF-debug", "mype(w)=", mype, "define_clm_statevec: clm_statevecsize=", clm_statevecsize #endif IF (allocated(clm_statevec)) deallocate(clm_statevec) @@ -449,11 +449,11 @@ subroutine define_clm_statevec_swc(mype) #ifdef PDAF_DEBUG ! Check that all state vectors have been assigned c, i if(state_pdaf2clm_c_p(cc) == ispval) then - write(*,*) 'cc: ', cc + write(*,*) "cc: ", cc error stop "state_pdaf2clm_c_p not set at cc" end if if(state_pdaf2clm_j_p(cc) == ispval) then - write(*,*) 'cc: ', cc + write(*,*) "cc: ", cc error stop "state_pdaf2clm_j_p not set at cc" end if #endif @@ -752,18 +752,18 @@ subroutine set_clm_statevec(tstartcycle, mype) ! calculate shift when CRP data are assimilated if(clmupdate_swc==2) then error stop "Not implemented clmupdate_swc.eq.2" - endif + end if !hcp LAI if(clmupdate_T==1) then error stop "Not implemented: clmupdate_T.eq.1" - endif + end if !end hcp LAI ! write average swc to state vector (CRP assimilation) if(clmupdate_swc==2) then error stop "Not implemented: clmupdate_swc.eq.2" - endif + end if ! write texture values to state vector (if desired) if(clmupdate_texture/=0) then @@ -779,7 +779,7 @@ subroutine set_clm_statevec(tstartcycle, mype) cc = cc + 1 end do end do - endif + end if if (clmupdate_tws==1) then call set_clm_statevec_tws @@ -1204,7 +1204,7 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") ! calculate shift when CRP data are assimilated if(obs_type_update_swc==2) then error stop "Not implemented: clmupdate_swc.eq.2" - endif + end if ! CLM5: Update the Data Assimulation time-step to the current time ! step, since DA has been done. Used by CLM5 to skip BalanceChecks @@ -1214,18 +1214,18 @@ subroutine update_clm(tstartcycle, mype) bind(C,name="update_clm") ! write updated swc back to CLM if(obs_type_update_swc/=0) then call update_clm_swc(tstartcycle, mype) - endif + end if !hcp: TG, TV if(obs_type_update_T==1) then error stop "Not implemented: clmupdate_T.eq.1" - endif + end if ! end hcp TG, TV ! write updated texture back to CLM if(obs_type_update_texture/=0) then call update_clm_texture(tstartcycle, mype) - endif + end if if (obs_type_update_tws==1) then call clm_update_tws @@ -1371,12 +1371,12 @@ subroutine update_clm_swc(tstartcycle, mype) swc(j,i) = watsat(j,i) else swc(j,i) = swc_update - endif + end if if (ieee_is_nan(swc(j,i))) then swc(j,i) = watmin_set print *, "WARNING: swc at j,i is nan: ", j, i - endif + end if if(swc_zero_before_update) then ! This case should not appear for hydrologically @@ -2019,7 +2019,7 @@ subroutine clm_texture_to_parameters() perc_frac = perc_norm*(om_frac - pcalpha)**pcbeta else perc_frac = 0._r8 - endif + end if ! uncon_frac is fraction of mineral soil plus fraction of ! "nonpercolating" organic soil @@ -2182,7 +2182,7 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & else if(((lat_clmobs(i) + 90) - minlat) == 0) then longxy_obs(i) = ceiling(((lon_clmobs(i) + 180) - minlon) * ni / (maxlon - minlon)) latixy_obs(i) = 1 - endif + end if end do ! deallocate temporary arrays !deallocate(longxy) @@ -2269,7 +2269,7 @@ subroutine get_interp_idx(lon_clmobs, lat_clmobs, dim_obs, longxy_obs_floor, lat else if(((lat_clmobs(i) + 90) - minlat) == 0) then longxy_obs_floor(i) = floor(((lon_clmobs(i) + 180) - minlon) * ni / (maxlon - minlon)) latixy_obs_floor(i) = 1 - endif + end if end do end subroutine get_interp_idx @@ -2437,21 +2437,21 @@ subroutine init_dim_l_clm(domain_p, dim_l) dim_l = nlevsoi nshift = nlevsoi end if - endif + end if if(clmupdate_swc==2) then error stop "Not implemented: clmupdate_swc.eq.2" ! dim_l = nlevsoi + 1 ! nshift = nlevsoi + 1 - endif + end if if(clmupdate_texture==1) then dim_l = 2*nlevsoi + nshift - endif + end if if(clmupdate_texture==2) then dim_l = 3*nlevsoi + nshift - endif + end if if (clmupdate_tws==1) then dim_l = 0 @@ -2499,7 +2499,7 @@ subroutine init_dim_l_clm(domain_p, dim_l) error stop "Unsupported state_setup" end select - endif + end if end subroutine init_dim_l_clm @@ -2746,7 +2746,7 @@ subroutine l2g_state_clm(domain_p, dim_l, state_l, dim_p, state_p) end select - endif NOGRACE + end if NOGRACE end subroutine l2g_state_clm #endif diff --git a/interface/model/eclm/print_update_clm_5.F90 b/interface/model/eclm/print_update_clm_5.F90 index c4134753..b847ffa3 100644 --- a/interface/model/eclm/print_update_clm_5.F90 +++ b/interface/model/eclm/print_update_clm_5.F90 @@ -102,24 +102,24 @@ subroutine print_update_clm(ts,ttot) bind(C,name="print_update_clm") if(clmprint_swc==1) then status = nf90_def_var(il_file_id, "swc", NF90_DOUBLE, dimids, ncvarid(1)) - endif + end if if(clmupdate_texture==1) then status = nf90_def_var(il_file_id, "sand", NF90_DOUBLE, dimids, ncvarid(2)) status = nf90_def_var(il_file_id, "clay", NF90_DOUBLE, dimids, ncvarid(3)) - endif + end if ! write updates to sand, clay and organic matter if(clmupdate_texture==2) then status = nf90_def_var(il_file_id, "sand", NF90_DOUBLE, dimids, ncvarid(2)) status = nf90_def_var(il_file_id, "clay", NF90_DOUBLE, dimids, ncvarid(3)) status = nf90_def_var(il_file_id, "orgm", NF90_DOUBLE, dimids, ncvarid(4)) - endif + end if status = nf90_enddef(il_file_id) else status = nf90_open(update_filename,NF90_WRITE,il_file_id) - endif - endif + end if + end if if(clmprint_swc==1) then @@ -206,7 +206,7 @@ subroutine print_update_clm(ts,ttot) bind(C,name="print_update_clm") start = [ 1, 1, 1, ts], count = [ ndlon, ndlat, nlevsoi, 1] ) !status = nf90_close(il_file_id) end if - endif + end if end if @@ -532,7 +532,7 @@ subroutine get_update_filename (iofile) write(cdate,'(i4.4,"-",i2.2)') yr,mon call get_curr_date (yr, mon, day, sec) !write(cdate,'(i4.4,"-",i2.2,"-",i2.2,"-",i5.5)') yr,mon,day,sec - write(cdate,'(i4.4)') yr + write(cdate,"(i4.4)") yr iofile = trim(caseid)//".update."//trim(cdate)//".nc" !iofile = trim(caseid)//".update.nc" end subroutine get_update_filename From 9fd97de0d5a780b359236e0b9ce64a10d49bd8f0 Mon Sep 17 00:00:00 2001 From: Johannes Keller Date: Fri, 29 May 2026 10:43:31 +0200 Subject: [PATCH 3/3] fix fortitude rule C181 unchecked-stat https://fortitude.readthedocs.io/en/stable/rules/unchecked-stat/ --- interface/framework/mod_read_obs.F90 | 10 +++++----- interface/model/eclm/enkf_clm_mod_5.F90 | 12 ++++++------ interface/model/eclm/print_update_clm_5.F90 | 16 +++++++--------- 3 files changed, 18 insertions(+), 20 deletions(-) diff --git a/interface/framework/mod_read_obs.F90 b/interface/framework/mod_read_obs.F90 index d257cf14..51d2c59b 100755 --- a/interface/framework/mod_read_obs.F90 +++ b/interface/framework/mod_read_obs.F90 @@ -1028,7 +1028,7 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & integer, allocatable, intent(inout) :: latixy(:) integer, allocatable, intent(inout) :: longxy_obs(:) integer, allocatable, intent(inout) :: latixy_obs(:) - integer :: ni, nj, ii, jj, kk, cid, ier, ncells, nlunits, & + integer :: ni, nj, ii, jj, kk, cid, ncells, nlunits, & ncols, npatches, ncohorts, counter, i, g, ll real :: minlon, minlat, maxlon, maxlat real(r8), pointer :: lon(:) @@ -1069,8 +1069,8 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & if (allocated(longxy)) deallocate(longxy) if (allocated(latixy)) deallocate(latixy) - allocate(longxy(num_hactiveg), stat=ier) - allocate(latixy(num_hactiveg), stat=ier) + allocate(longxy(num_hactiveg)) + allocate(latixy(num_hactiveg)) longxy(:) = 0 @@ -1162,8 +1162,8 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & if (allocated(longxy_obs)) deallocate(longxy_obs) if (allocated(latixy_obs)) deallocate(latixy_obs) - allocate(longxy_obs(dim_obs), stat=ier) - allocate(latixy_obs(dim_obs), stat=ier) + allocate(longxy_obs(dim_obs)) + allocate(latixy_obs(dim_obs)) in_mpi_(2,:) = longxy_obs_lokal call mpi_allreduce(in_mpi_,out_mpi_, dim_obs, mpi_2integer, mpi_minloc, comm_filter, ierror) diff --git a/interface/model/eclm/enkf_clm_mod_5.F90 b/interface/model/eclm/enkf_clm_mod_5.F90 index 5fe6d272..68bd8c54 100755 --- a/interface/model/eclm/enkf_clm_mod_5.F90 +++ b/interface/model/eclm/enkf_clm_mod_5.F90 @@ -2126,9 +2126,9 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & ! allocate vector with size of elements in x directions * size of elements in y directions if(allocated(longxy)) deallocate(longxy) - allocate(longxy(ncells), stat=ier) + allocate(longxy(ncells)) if(allocated(latixy)) deallocate(latixy) - allocate(latixy(ncells), stat=ier) + allocate(latixy(ncells)) ! initialize vector with zero values longxy(:) = 0 @@ -2162,9 +2162,9 @@ subroutine domain_def_clm(lon_clmobs, lat_clmobs, dim_obs, & maxlat = MAXVAL(lat(:) + 90) if(allocated(longxy_obs)) deallocate(longxy_obs) - allocate(longxy_obs(dim_obs), stat=ier) + allocate(longxy_obs(dim_obs)) if(allocated(latixy_obs)) deallocate(latixy_obs) - allocate(latixy_obs(dim_obs), stat=ier) + allocate(latixy_obs(dim_obs)) do i = 1, dim_obs if(((lon_clmobs(i) + 180) - minlon) /= 0 .and. & @@ -2252,9 +2252,9 @@ subroutine get_interp_idx(lon_clmobs, lat_clmobs, dim_obs, longxy_obs_floor, lat maxlat = MAXVAL(lat(:) + 90) if(allocated(longxy_obs_floor)) deallocate(longxy_obs_floor) - allocate(longxy_obs_floor(dim_obs), stat=ier) + allocate(longxy_obs_floor(dim_obs)) if(allocated(latixy_obs_floor)) deallocate(latixy_obs_floor) - allocate(latixy_obs_floor(dim_obs), stat=ier) + allocate(latixy_obs_floor(dim_obs)) do i = 1, dim_obs if(((lon_clmobs(i) + 180) - minlon) /= 0 .and. ((lat_clmobs(i) + 90) - minlat) /= 0) then longxy_obs_floor(i) = floor(((lon_clmobs(i) + 180) - minlon) * ni / (maxlon - minlon)) !+ 1 diff --git a/interface/model/eclm/print_update_clm_5.F90 b/interface/model/eclm/print_update_clm_5.F90 index b847ffa3..07ea27cd 100644 --- a/interface/model/eclm/print_update_clm_5.F90 +++ b/interface/model/eclm/print_update_clm_5.F90 @@ -75,20 +75,19 @@ subroutine print_update_clm(ts,ttot) bind(C,name="print_update_clm") integer ,dimension(1) :: il_var_id integer :: il_file_id, ncvarid(4), status character(len = 300) :: update_filename - integer :: nerror integer :: ndlon,ndlat call get_proc_global(ng=numg,nl=numl,nc=numc,np=nump) call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) - ! allocate(clmstate_tmp_local(nlevsoi*(-begc+endc)), stat=nerror) + ! allocate(clmstate_tmp_local(nlevsoi*(-begc+endc))) ndlon = ldomain%ni ndlat = ldomain%nj if (masterproc) then - ! allocate(clmstate_tmp_global(nlevsoi*numg), stat=nerror) - allocate(clmstate_out(ndlon,ndlat,nlevsoi), stat=nerror) + ! allocate(clmstate_tmp_global(nlevsoi*numg)) + allocate(clmstate_out(ndlon,ndlat,nlevsoi)) end if if(masterproc) then @@ -278,7 +277,6 @@ subroutine print_inc_clm() bind(C,name="print_inc_clm") integer ,dimension(1) :: il_var_id integer :: il_file_id, ncvarid(4), status character(len = 300) :: inc_filename - integer :: nerror integer :: ndlon,ndlat integer :: ier !return code @@ -297,8 +295,8 @@ subroutine print_inc_clm() bind(C,name="print_inc_clm") call get_proc_global(ng=numg,nl=numl,nc=numc,np=nump) call get_proc_bounds(begg,endg,begl,endl,begc,endc,begp,endp) - allocate(clmstate_tmp_local(begg:endg,1:nlevsoi), stat=nerror) - allocate(tws_inc(begg:endg), stat=nerror) + allocate(clmstate_tmp_local(begg:endg,1:nlevsoi)) + allocate(tws_inc(begg:endg)) tws_inc(begg:endg) = 0._r8 ndlon = ldomain%ni @@ -306,8 +304,8 @@ subroutine print_inc_clm() bind(C,name="print_inc_clm") if (masterproc) then - allocate(clmstate_tmp_global(1:numg), stat=nerror) - allocate(clmstate_out(ndlon,ndlat,nlevsoi), stat=nerror) + allocate(clmstate_tmp_global(1:numg)) + allocate(clmstate_out(ndlon,ndlat,nlevsoi)) clmstate_out(:,:,:) = nan end if