From 3bb1a64e665dd89989d766b3db5adf8fb102cbe0 Mon Sep 17 00:00:00 2001 From: Matt Shin Date: Mon, 18 May 2026 17:25:33 +0100 Subject: [PATCH 1/2] Fortitude 0.9 happiness Fix syntax errors manually. Add config. - To target f2008. - Ignore various rules in `deps/` directory. Then ran with `fortitude check --fix`. Fix remaining failures manually. --- .fortitude.toml | 34 ++++++++++++++ deps/gcom/gc/gc__buildconst.F90 | 4 +- deps/gcom/gc/gc__errlim.F90 | 10 ++--- deps/gcom/gc/gc__flush.F90 | 9 ++-- deps/gcom/gc/gc__stamp.F90 | 12 ++--- deps/gcom/gc/gc_abort.F90 | 10 ++--- deps/gcom/gc/gc_config.F90 | 21 ++++----- deps/gcom/gc/gc_getopt.F90 | 2 +- deps/gcom/gc/gc_imax_single_task.F90 | 2 +- deps/gcom/gc/gc_imin_single_task.F90 | 2 +- deps/gcom/gc/gc_init.F90 | 12 ++--- deps/gcom/gc/gc_init_thread.F90 | 36 ++++++++------- deps/gcom/gc/gc_kinds_mod.F90 | 2 +- deps/gcom/gc/gc_rmax_single_task.F90 | 2 +- deps/gcom/gc/gc_rmin_single_task.F90 | 2 +- deps/gcom/gc/gc_setopt.F90 | 4 +- deps/gcom/gcg/gcg__errlim.F90 | 10 ++--- deps/gcom/gcg/gcg__mpi_rank.F90 | 2 +- deps/gcom/gcg/gcg_ralltoalle.F90 | 7 ++- deps/gcom/gcg/gcg_ralltoalle_multi.F90 | 7 ++- deps/gcom/gcg/gcg_rvecshift.F90 | 7 +-- deps/gcom/mpl/mpl_pack.F90 | 2 +- deps/gcom/mpl/mpl_unpack.F90 | 2 +- deps/odb/stubs/yomhook.F90 | 2 +- .../OpsMod_ModelObInfo/OpsMod_ModelObInfo.f90 | 4 +- .../code/OpsMod_ObsInfo/OpsMod_ObsInfo.f90 | 6 +-- .../OpsMod_Utilities/Ops_PressureToHeight.f90 | 2 +- .../public/GenMod_Control/GenMod_Control.F90 | 2 +- deps/ops/public/GenMod_Core/GenMod_Core.F90 | 4 +- .../public/GenMod_Platform/GenMod_Matmul.F90 | 4 +- .../OpsMod_FieldDataShared.f90 | 6 +-- .../OpsMod_CXGenerate/OpsMod_SharedMemory.f90 | 26 +++++------ .../OpsMod_GroundGPS/OpsMod_GroundGPS.f90 | 2 +- .../OpsMod_ODB/OpsMod_ODBOPSInterface.f90 | 2 +- .../stubs/OpsMod_ODB/OpsMod_ODBTableInfo.f90 | 2 +- .../stubs/OpsMod_ODB/OpsProg_CreateODB.f90 | 34 +++++++------- .../ops/stubs/OpsMod_ODB/OpsProg_SimulObs.f90 | 44 +++++++++---------- .../stubs/Ops_Constants/OpsMod_Constants.f90 | 2 +- deps/ops/stubs/Ops_Constants/OpsMod_Kinds.F90 | 11 ++++- src/opsinputs/CxWriter.interface.F90 | 8 ++-- src/opsinputs/VarObsWriter.interface.F90 | 12 ++--- src/opsinputs/opsinputs_cxgenerate_mod.F90 | 1 + src/opsinputs/opsinputs_cxwriter_mod.F90 | 6 +-- src/opsinputs/opsinputs_fill_mod.F90 | 24 +++++----- src/opsinputs/opsinputs_mpl_mod.F90 | 1 + .../opsinputs_obsdatavector_interface.f90 | 16 +++---- src/opsinputs/opsinputs_obsdatavector_mod.F90 | 2 - .../opsinputs_obsspace_interface.f90 | 6 +-- src/opsinputs/opsinputs_obsspace_mod.F90 | 6 +-- src/opsinputs/opsinputs_varobswriter_mod.F90 | 18 ++++---- 50 files changed, 249 insertions(+), 205 deletions(-) create mode 100644 .fortitude.toml diff --git a/.fortitude.toml b/.fortitude.toml new file mode 100644 index 00000000..0d85b107 --- /dev/null +++ b/.fortitude.toml @@ -0,0 +1,34 @@ +[check] +target-std="f2008" +line-length=140 + +[check.per-file-ignores] +"deps/**" = [ + "C001", # implicit-typing + "C061", # missing-intent + "C071", # assumed-size + "C072", # assumed-size-character-intent + "C091", # external-procedure + "C092", # procedure-not-in-module + "C131", # missing-accessibility-statement +] +"deps/ops/public/GenMod_Platform/**" = [ + "C002", # interface-implicit-typing +] +"deps/ops/public/GenMod_Sleep/GenMod_Sleep.f90" = [ + "C002", # interface-implicit-typing +] +"src/opsinputs/opsinputs_cxfields_mod.F90" = [ + "C121", # use-all +] +"src/opsinputs/opsinputs_cxwriter_mod.F90" = [ + "C121", # use-all +] +"src/opsinputs/opsinputs_mpl_mod.F90" = [ + "C061", # missing-intent + "C091", # external-procedure +] +"src/opsinputs/opsinputs_varobswriter_mod.F90" = [ + "C091", # external-procedure + "C121", # use-all +] diff --git a/deps/gcom/gc/gc__buildconst.F90 b/deps/gcom/gc/gc__buildconst.F90 index 41dccb9c..51451513 100644 --- a/deps/gcom/gc/gc__buildconst.F90 +++ b/deps/gcom/gc/gc__buildconst.F90 @@ -66,10 +66,10 @@ MODULE gc__buildconst IMPLICIT NONE PRIVATE -PUBLIC :: & #if defined(MPI_SRC) - mpiabort_errno, mpi_bsend_buffer_size, & +PUBLIC :: mpiabort_errno, mpi_bsend_buffer_size #endif +PUBLIC :: & gc_version, gc_build_date, gc_int_type, gc_real_type, gc_descrip, gc__isize, & gc__rsize, gc__forterrunit diff --git a/deps/gcom/gc/gc__errlim.F90 b/deps/gcom/gc/gc__errlim.F90 index b00e2731..17dbbefb 100644 --- a/deps/gcom/gc/gc__errlim.F90 +++ b/deps/gcom/gc/gc__errlim.F90 @@ -24,12 +24,12 @@ SUBROUTINE gc__errlim(iabrt, sub, lim, mval, aval) INTEGER (KIND=gc_int_kind) :: iabrt, mval, aval CHARACTER(LEN=*) :: sub, lim -WRITE(*,*) 'GC_', sub, '(): internal limit MAX_', lim, & - ' exceeded on processor ', gc_me() -WRITE(*,*) 'Maximum value is ', mval, '. Actual value is ', & - aval, '. Exiting.' +WRITE(*,*) "GC_", sub, "(): internal limit MAX_", lim, & + " exceeded on processor ", gc_me() +WRITE(*,*) "Maximum value is ", mval, ". Actual value is ", & + aval, ". Exiting." -CALL gc_abort(gc_me(), gc_nproc(), '*** STATIC LIMIT EXCEEDED ***') +CALL gc_abort(gc_me(), gc_nproc(), "*** STATIC LIMIT EXCEEDED ***") RETURN END SUBROUTINE gc__errlim diff --git a/deps/gcom/gc/gc__flush.F90 b/deps/gcom/gc/gc__flush.F90 index fbd00b4b..da69a7e7 100644 --- a/deps/gcom/gc/gc__flush.F90 +++ b/deps/gcom/gc/gc__flush.F90 @@ -26,12 +26,11 @@ SUBROUTINE gc__flush(lunit) USE f90_unix_io,ONLY:FLUSH #endif -USE gc_kinds_mod, ONLY: & -#if defined(LINUX_NAG_COMPILER) || defined(_X1) || defined(XD1) \ -|| defined(XT3) - gc_integer32, & +#if defined(LINUX_NAG_COMPILER) || defined(_X1) || defined(XD1) || defined(XT3) +USE gc_kinds_mod, ONLY: gc_int_kind, gc_integer32 +#else +USE gc_kinds_mod, ONLY: gc_int_kind #endif - gc_int_kind IMPLICIT NONE diff --git a/deps/gcom/gc/gc__stamp.F90 b/deps/gcom/gc/gc__stamp.F90 index 39192bd0..8bd94165 100644 --- a/deps/gcom/gc/gc__stamp.F90 +++ b/deps/gcom/gc/gc__stamp.F90 @@ -10,16 +10,16 @@ SUBROUTINE gc__stamp() IMPLICIT NONE WRITE(6,*) -WRITE(6,*) '=====================================================' -WRITE(6,*) 'GCOM Version ', & +WRITE(6,*) "=====================================================" +WRITE(6,*) "GCOM Version ", & gc_version WRITE(6,*) & gc_descrip -WRITE(6,*) 'Using precision : ', & - gc_int_type , ' and ', gc_real_type -WRITE(6,*) 'Built at ', & +WRITE(6,*) "Using precision : ", & + gc_int_type , " and ", gc_real_type +WRITE(6,*) "Built at ", & gc_build_date -WRITE(6,*) '=====================================================' +WRITE(6,*) "=====================================================" WRITE(6,*) RETURN diff --git a/deps/gcom/gc/gc_abort.F90 b/deps/gcom/gc/gc_abort.F90 index 18b8e689..afb18118 100644 --- a/deps/gcom/gc/gc_abort.F90 +++ b/deps/gcom/gc/gc_abort.F90 @@ -26,11 +26,11 @@ SUBROUTINE gc_abort (me, nproc, mesg) USE mpl, ONLY: mpl_comm_world #endif -USE gc__buildconst, ONLY: & #if defined(MPI_SRC) - mpiabort_errno, & +USE gc__buildconst, ONLY: gc__forterrunit, mpiabort_errno +#else +USE gc__buildconst, ONLY: gc__forterrunit #endif - gc__forterrunit USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: OUTPUT_UNIT @@ -40,9 +40,9 @@ SUBROUTINE gc_abort (me, nproc, mesg) INTEGER (KIND=gc_int_kind) :: me, nproc, i, info CHARACTER(LEN=*) :: mesg -CHARACTER(LEN=*), PARAMETER :: seqf2 = '(a20,i5,a3,a)' +CHARACTER(LEN=*), PARAMETER :: seqf2 = "(a20,i5,a3,a)" -WRITE(gc__forterrunit,seqf2) 'gc_abort (Processor ',me,'): ', mesg +WRITE(gc__forterrunit,seqf2) "gc_abort (Processor ",me,"): ", mesg CALL gc__flush(gc__forterrunit) CALL gc__flush(INT(OUTPUT_UNIT, KIND=gc_int_kind)) diff --git a/deps/gcom/gc/gc_config.F90 b/deps/gcom/gc/gc_config.F90 index f7629400..a55eb657 100644 --- a/deps/gcom/gc/gc_config.F90 +++ b/deps/gcom/gc/gc_config.F90 @@ -36,20 +36,21 @@ SUBROUTINE gc_config (mxproc, mxcoll, mxpt2pt, intf) INTEGER (KIND=gc_int_kind) :: mxproc, mxcoll, mxpt2pt CHARACTER(LEN=*) :: intf +#if defined(PREC_32B) +CHARACTER(LEN=*), PARAMETER :: gc_descrip_value = " 32" +#else +CHARACTER(LEN=*), PARAMETER :: gc_descrip_value = " 64" +#endif + mxcoll = 0 ! Deprecated mxproc = 0 ! Deprecated mxpt2pt = gc_none ! Deprecated -intf = 'GCOM Version ' // & +intf = "GCOM Version " // & gc_version // & - ' built at ' // & + " built at " // & gc_build_date // & - ' Interface: ' // & -#if defined(PREC_32B) - gc_descrip // & - ' 32' -#else -gc_descrip // & -' 64' -#endif + " Interface: " // & + gc_descrip // & + gc_descrip_value END SUBROUTINE gc_config diff --git a/deps/gcom/gc/gc_getopt.F90 b/deps/gcom/gc/gc_getopt.F90 index 5f9c1177..4d1de81a 100644 --- a/deps/gcom/gc/gc_getopt.F90 +++ b/deps/gcom/gc/gc_getopt.F90 @@ -37,7 +37,7 @@ SUBROUTINE gc_getopt(var, val, istat) IF (var > gc__max_opts .OR. var < 1) THEN ! VAR is out of range CALL gc_abort(gc_me(), gc_nproc(), & - 'Cannot get option - out of range') + "Cannot get option - out of range") END IF val = gc__options(var) diff --git a/deps/gcom/gc/gc_imax_single_task.F90 b/deps/gcom/gc/gc_imax_single_task.F90 index d24efe90..8542237b 100644 --- a/deps/gcom/gc/gc_imax_single_task.F90 +++ b/deps/gcom/gc/gc_imax_single_task.F90 @@ -46,7 +46,7 @@ SUBROUTINE gc_imax_single_task (len1, nproc, istat, imax, root) INTEGER (KIND=gc_int_kind), INTENT(IN) :: nproc INTEGER (KIND=gc_int_kind), INTENT(IN) :: root INTEGER (KIND=gc_int_kind), INTENT(OUT) :: istat -INTEGER (KIND=gc_int_kind), INTENT(IN OUT) :: imax(len1) +INTEGER (KIND=gc_int_kind), INTENT(INOUT) :: imax(len1) INTEGER (KIND=gc_int_kind) :: reduce_data_iwrk(len1) diff --git a/deps/gcom/gc/gc_imin_single_task.F90 b/deps/gcom/gc/gc_imin_single_task.F90 index 5c18f28a..12956f49 100644 --- a/deps/gcom/gc/gc_imin_single_task.F90 +++ b/deps/gcom/gc/gc_imin_single_task.F90 @@ -46,7 +46,7 @@ SUBROUTINE gc_imin_single_task (len1, nproc, istat, imin, root) INTEGER (KIND=gc_int_kind), INTENT(IN) :: nproc INTEGER (KIND=gc_int_kind), INTENT(IN) :: root INTEGER (KIND=gc_int_kind), INTENT(OUT) :: istat -INTEGER (KIND=gc_int_kind), INTENT(IN OUT) :: imin(len1) +INTEGER (KIND=gc_int_kind), INTENT(INOUT) :: imin(len1) INTEGER (KIND=gc_int_kind) :: reduce_data_iwrk(len1) diff --git a/deps/gcom/gc/gc_init.F90 b/deps/gcom/gc/gc_init.F90 index b2023ab4..9a3296c6 100644 --- a/deps/gcom/gc/gc_init.F90 +++ b/deps/gcom/gc/gc_init.F90 @@ -53,11 +53,11 @@ SUBROUTINE gc_init_intro (comm) USE mpl, ONLY: & mpl_comm_world -USE gc_kinds_mod, ONLY: & #if defined(MPI_SRC) - gc_log_kind, & +USE gc_kinds_mod, ONLY: gc_int_kind, gc_log_kind +#else +USE gc_kinds_mod, ONLY: gc_int_kind #endif - gc_int_kind IMPLICIT NONE @@ -111,11 +111,11 @@ SUBROUTINE gc_init_final (me,nproc,comm) USE gc__buildconst, ONLY: gc__isize, mpi_bsend_buffer_size #endif -USE gc_kinds_mod, ONLY: & #if defined(MPI_SRC) - gc_log_kind, & +USE gc_kinds_mod, ONLY: gc_int_kind, gc_log_kind +#else +USE gc_kinds_mod, ONLY: gc_int_kind #endif - gc_int_kind IMPLICIT NONE diff --git a/deps/gcom/gc/gc_init_thread.F90 b/deps/gcom/gc/gc_init_thread.F90 index 79b1ba94..fbe6c4f8 100644 --- a/deps/gcom/gc/gc_init_thread.F90 +++ b/deps/gcom/gc/gc_init_thread.F90 @@ -58,20 +58,24 @@ SUBROUTINE gc_init_thread (me, nproc, requested) IF (me==0) THEN IF (actual/=requested) THEN - WRITE(6,'(A)')'WARNING - REQUESTED AND ACTUAL THREADING LEVEL DIFFERENT' + WRITE(6,"(A)")"WARNING - REQUESTED AND ACTUAL THREADING LEVEL DIFFERENT" END IF - IF (requested == mpl_thread_multiple) & - WRITE(6,'(A)')'THREAD LEVEL REQUESTED is MPL_THREAD_MULTIPLE' - IF (requested == mpl_thread_serialized) & - WRITE(6,'(A)')'THREAD LEVEL REQUESTED is MPL_THREAD_SERIALIZED' - IF (requested == mpl_thread_funneled) & - WRITE(6,'(A)')'THREAD LEVEL REQUESTED is MPL_THREAD_FUNNELED' - IF (requested == mpl_thread_single) & - WRITE(6,'(A)')'THREAD LEVEL REQUESTED is MPL_THREAD_SINGLE' - IF (actual==mpl_thread_multiple) WRITE(6,'(A)')'THREAD LEVEL SET is MPL_THREAD_MULTIPLE' - IF (actual==mpl_thread_serialized) WRITE(6,'(A)')'THREAD LEVEL SET is MPL_THREAD_SERIALIZED' - IF (actual==mpl_thread_funneled) WRITE(6,'(A)')'THREAD LEVEL SET is MPL_THREAD_FUNNELED' - IF (actual==mpl_thread_single) WRITE(6,'(A)')'THREAD LEVEL SET is MPL_THREAD_SINGLE' + IF (requested == mpl_thread_multiple) then + WRITE(6,"(A)")"THREAD LEVEL REQUESTED is MPL_THREAD_MULTIPLE" + end if + IF (requested == mpl_thread_serialized) then + WRITE(6,"(A)")"THREAD LEVEL REQUESTED is MPL_THREAD_SERIALIZED" + end if + IF (requested == mpl_thread_funneled) then + WRITE(6,"(A)")"THREAD LEVEL REQUESTED is MPL_THREAD_FUNNELED" + end if + IF (requested == mpl_thread_single) then + WRITE(6,"(A)")"THREAD LEVEL REQUESTED is MPL_THREAD_SINGLE" + end if + IF (actual==mpl_thread_multiple) WRITE(6,"(A)")"THREAD LEVEL SET is MPL_THREAD_MULTIPLE" + IF (actual==mpl_thread_serialized) WRITE(6,"(A)")"THREAD LEVEL SET is MPL_THREAD_SERIALIZED" + IF (actual==mpl_thread_funneled) WRITE(6,"(A)")"THREAD LEVEL SET is MPL_THREAD_FUNNELED" + IF (actual==mpl_thread_single) WRITE(6,"(A)")"THREAD LEVEL SET is MPL_THREAD_SINGLE" END IF RETURN @@ -82,11 +86,11 @@ SUBROUTINE gc_init_intro_thread (comm, requested) USE mpl, ONLY: & mpl_comm_world -USE gc_kinds_mod, ONLY: & #if defined(MPI_SRC) - gc_log_kind, & +USE gc_kinds_mod, ONLY: gc_int_kind, gc_log_kind +#else +USE gc_kinds_mod, ONLY: gc_int_kind #endif - gc_int_kind IMPLICIT NONE diff --git a/deps/gcom/gc/gc_kinds_mod.F90 b/deps/gcom/gc/gc_kinds_mod.F90 index b477177d..d147a097 100644 --- a/deps/gcom/gc/gc_kinds_mod.F90 +++ b/deps/gcom/gc/gc_kinds_mod.F90 @@ -56,4 +56,4 @@ MODULE gc_kinds_mod INTEGER, PARAMETER :: gc_real_kind = gc_real64 #endif -END MODULE +END MODULE gc_kinds_mod diff --git a/deps/gcom/gc/gc_rmax_single_task.F90 b/deps/gcom/gc/gc_rmax_single_task.F90 index 31b5e8f2..ae0659dc 100644 --- a/deps/gcom/gc/gc_rmax_single_task.F90 +++ b/deps/gcom/gc/gc_rmax_single_task.F90 @@ -46,7 +46,7 @@ SUBROUTINE gc_rmax_single_task (len1, nproc, istat, smax, root) INTEGER (KIND=gc_int_kind), INTENT(IN) :: nproc INTEGER (KIND=gc_int_kind), INTENT(IN) :: root INTEGER (KIND=gc_int_kind), INTENT(OUT) :: istat -REAL (KIND=gc_real_kind), INTENT(IN OUT) :: smax(len1) +REAL (KIND=gc_real_kind), INTENT(INOUT) :: smax(len1) REAL (KIND=gc_real_kind) :: reduce_data_wrk(len1) diff --git a/deps/gcom/gc/gc_rmin_single_task.F90 b/deps/gcom/gc/gc_rmin_single_task.F90 index 64a1248f..91910651 100644 --- a/deps/gcom/gc/gc_rmin_single_task.F90 +++ b/deps/gcom/gc/gc_rmin_single_task.F90 @@ -46,7 +46,7 @@ SUBROUTINE gc_rmin_single_task (len1, nproc, istat, smin, root) INTEGER (KIND=gc_int_kind), INTENT(IN) :: nproc INTEGER (KIND=gc_int_kind), INTENT(IN) :: root INTEGER (KIND=gc_int_kind), INTENT(OUT) :: istat -REAL (KIND=gc_real_kind), INTENT(IN OUT) :: smin(len1) +REAL (KIND=gc_real_kind), INTENT(INOUT) :: smin(len1) REAL (KIND=gc_real_kind) :: reduce_data_wrk(len1) diff --git a/deps/gcom/gc/gc_setopt.F90 b/deps/gcom/gc/gc_setopt.F90 index 361d6b26..73af99c8 100644 --- a/deps/gcom/gc/gc_setopt.F90 +++ b/deps/gcom/gc/gc_setopt.F90 @@ -45,14 +45,14 @@ SUBROUTINE gc_setopt(var, val, istat) ! Ensure Option is one we recognise IF (var > gc__max_opts .OR. var < 1) THEN CALL gc_abort(gc_me(), gc_nproc(), & - 'Cannot set option - unrecognised') + "Cannot set option - unrecognised") END IF ! Ensure Option values are recognised IF (var == gc_force_bitrep .AND. & (val /= gc_on .AND. val /= gc_off)) THEN CALL gc_abort(gc_me(), gc_nproc(), & - 'Cannot set GC_FORCE_BITREP - value unrecognised') + "Cannot set GC_FORCE_BITREP - value unrecognised") END IF gc__options(var) = val diff --git a/deps/gcom/gcg/gcg__errlim.F90 b/deps/gcom/gcg/gcg__errlim.F90 index 959e05d2..92615aca 100644 --- a/deps/gcom/gcg/gcg__errlim.F90 +++ b/deps/gcom/gcg/gcg__errlim.F90 @@ -27,12 +27,12 @@ SUBROUTINE gcg__errlim(iabrt, sub, lim, mval, aval) gcg__me = gc_me() gcg__nproc = gc_nproc() -WRITE(*,*) 'GCG_', sub, '(): internal limit MAX_', lim, & - ' exceeded on processor ', gcg__me -WRITE(*,*) 'Maximum value is ', mval, '. Actual value is ', & - aval, '. Exiting.' +WRITE(*,*) "GCG_", sub, "(): internal limit MAX_", lim, & + " exceeded on processor ", gcg__me +WRITE(*,*) "Maximum value is ", mval, ". Actual value is ", & + aval, ". Exiting." -CALL gc_abort(gcg__me, gcg__nproc, '*** DEFINED LIMIT EXCEEDED ***') +CALL gc_abort(gcg__me, gcg__nproc, "*** DEFINED LIMIT EXCEEDED ***") RETURN END SUBROUTINE gcg__errlim diff --git a/deps/gcom/gcg/gcg__mpi_rank.F90 b/deps/gcom/gcg/gcg__mpi_rank.F90 index 46e9e615..67b14dca 100644 --- a/deps/gcom/gcg/gcg__mpi_rank.F90 +++ b/deps/gcom/gcg/gcg__mpi_rank.F90 @@ -74,7 +74,7 @@ FUNCTION gcg__mpi_rank(dummy1,dummy2) #include "gc_functions.h" CALL gc_abort(gc_me(),gc_nproc(), & - 'GCG__MPI_RANK called for non-MPI') + "GCG__MPI_RANK called for non-MPI") gcg__mpi_rank = -1 diff --git a/deps/gcom/gcg/gcg_ralltoalle.F90 b/deps/gcom/gcg/gcg_ralltoalle.F90 index f5122927..9744d396 100644 --- a/deps/gcom/gcg/gcg_ralltoalle.F90 +++ b/deps/gcom/gcg/gcg_ralltoalle.F90 @@ -128,12 +128,11 @@ SUBROUTINE gcg__ralltoalle( & gc__mpi_maxtag #endif -USE gc_kinds_mod, ONLY: & #if defined(MPI_SRC) - gc_log_kind, & +USE gc_kinds_mod, ONLY: gc_int_kind, gc_real_kind, gc_log_kind +#else +USE gc_kinds_mod, ONLY: gc_int_kind, gc_real_kind #endif - gc_int_kind, & - gc_real_kind IMPLICIT NONE diff --git a/deps/gcom/gcg/gcg_ralltoalle_multi.F90 b/deps/gcom/gcg/gcg_ralltoalle_multi.F90 index 02c88518..2b4cc630 100644 --- a/deps/gcom/gcg/gcg_ralltoalle_multi.F90 +++ b/deps/gcom/gcg/gcg_ralltoalle_multi.F90 @@ -114,12 +114,11 @@ SUBROUTINE gcg__ralltoalle_multi( & gc__mpi_maxtag #endif -USE gc_kinds_mod, ONLY: & #if defined(MPI_SRC) - gc_log_kind, & +USE gc_kinds_mod, ONLY: gc_int_kind, gc_real_kind, gc_log_kind +#else +USE gc_kinds_mod, ONLY: gc_int_kind, gc_real_kind #endif - gc_int_kind, & - gc_real_kind IMPLICIT NONE diff --git a/deps/gcom/gcg/gcg_rvecshift.F90 b/deps/gcom/gcg/gcg_rvecshift.F90 index 963f25f3..77d5c61d 100644 --- a/deps/gcom/gcg/gcg_rvecshift.F90 +++ b/deps/gcom/gcg/gcg_rvecshift.F90 @@ -167,9 +167,10 @@ SUBROUTINE gcg_rvecshift (lvl, lsl, lso, nv, shft, wrap, field, & DO i = 0,gsize-1 gj = gj + glst(1,i) END DO - IF (gj > max_rotate) & - CALL gcg__errlim(1_gc_int_kind, 'RVECSHIFT', & - 'ROTATE', max_rotate, gj) + IF (gj > max_rotate) then + CALL gcg__errlim(1_gc_int_kind, "RVECSHIFT", & + "ROTATE", max_rotate, gj) + end if END IF diff --git a/deps/gcom/mpl/mpl_pack.F90 b/deps/gcom/mpl/mpl_pack.F90 index 1c6a6ec1..0cfe37c5 100644 --- a/deps/gcom/mpl/mpl_pack.F90 +++ b/deps/gcom/mpl/mpl_pack.F90 @@ -27,7 +27,7 @@ SUBROUTINE MPL_Pack (inbuf, incount, datatype, outbuf, outsize, posn, & INTEGER (KIND=gc_int_kind), INTENT(IN) :: datatype INTEGER (KIND=gc_int_kind), INTENT(OUT) :: outbuf(*) INTEGER (KIND=gc_int_kind), INTENT(IN) :: outsize -INTEGER (KIND=gc_int_kind), INTENT(IN OUT) :: posn +INTEGER (KIND=gc_int_kind), INTENT(INOUT) :: posn INTEGER (KIND=gc_int_kind), INTENT(IN) :: comm INTEGER (KIND=gc_int_kind), INTENT(OUT) :: ERROR diff --git a/deps/gcom/mpl/mpl_unpack.F90 b/deps/gcom/mpl/mpl_unpack.F90 index 5d4e1657..70f664dc 100644 --- a/deps/gcom/mpl/mpl_unpack.F90 +++ b/deps/gcom/mpl/mpl_unpack.F90 @@ -24,7 +24,7 @@ SUBROUTINE MPL_Unpack (inbuf, insize, posn, outbuf, outcount, & ! Arguments and Variables at Model/GCOM precision level INTEGER (KIND=gc_int_kind), INTENT(IN) :: inbuf(*) INTEGER (KIND=gc_int_kind), INTENT(IN) :: insize -INTEGER (KIND=gc_int_kind), INTENT(IN OUT) :: posn +INTEGER (KIND=gc_int_kind), INTENT(INOUT) :: posn INTEGER (KIND=gc_int_kind), INTENT(OUT) :: outbuf(*) INTEGER (KIND=gc_int_kind), INTENT(IN) :: outcount INTEGER (KIND=gc_int_kind), INTENT(IN) :: datatype diff --git a/deps/odb/stubs/yomhook.F90 b/deps/odb/stubs/yomhook.F90 index 5e258af7..6e3dc240 100644 --- a/deps/odb/stubs/yomhook.F90 +++ b/deps/odb/stubs/yomhook.F90 @@ -25,7 +25,7 @@ MODULE YOMHOOK DR_HOOK_MULTI_FILE_SIZE END INTERFACE -CONTAINS +CONTAINS SUBROUTINE DR_HOOK_DEFAULT(CDNAME,KSWITCH,PKEY) CHARACTER(LEN=*), INTENT(IN) :: CDNAME diff --git a/deps/ops/code/OpsMod_ModelObInfo/OpsMod_ModelObInfo.f90 b/deps/ops/code/OpsMod_ModelObInfo/OpsMod_ModelObInfo.f90 index 43989377..b9b2ab02 100644 --- a/deps/ops/code/OpsMod_ModelObInfo/OpsMod_ModelObInfo.f90 +++ b/deps/ops/code/OpsMod_ModelObInfo/OpsMod_ModelObInfo.f90 @@ -276,10 +276,10 @@ MODULE OpsMod_ModelObInfo ! correct REAL, POINTER :: SeaSrfcHeight(:) => NULL() ! Altimeter SSH cm REAL, POINTER :: SeaIce(:) => NULL() ! Sea Ice - REAL, POINTER :: CHL(:) => NULL() ! mass concentration of chlorophyll a + REAL, POINTER :: CHL(:) => NULL() ! mass concentration of chlorophyll a ! in sea water milligram m-3 REAL, POINTER :: KD490(:) => NULL() ! volume attenuation coefficient of downwelling - REAL, POINTER :: LCHL(:) => NULL() ! mass concentration of chlorophyll a + REAL, POINTER :: LCHL(:) => NULL() ! mass concentration of chlorophyll a ! in sea water milligram m-3 REAL, POINTER :: LKD490(:) => NULL() ! volume attenuation coefficient of downwelling REAL, POINTER :: SSTMes_Var(:) => NULL() ! mesoscale SST variance diff --git a/deps/ops/code/OpsMod_ObsInfo/OpsMod_ObsInfo.f90 b/deps/ops/code/OpsMod_ObsInfo/OpsMod_ObsInfo.f90 index ff0d0429..4fc4334c 100644 --- a/deps/ops/code/OpsMod_ObsInfo/OpsMod_ObsInfo.f90 +++ b/deps/ops/code/OpsMod_ObsInfo/OpsMod_ObsInfo.f90 @@ -672,7 +672,7 @@ MODULE OpsMod_ObsInfo REAL, POINTER :: AMSUscatindx(:) => NULL() ! AMSU scattering index (atovs) INTEGER, POINTER :: ATOVSProcOption(:) => NULL() ! processing options from 1DVAR (atovs) INTEGER, POINTER :: QCHIRSfov(:) => NULL() ! HIRS flags from ATOVPP (atovs) - INTEGER, POINTER :: QCGIIRSfov(:) => NULL() ! GIIRSflags + INTEGER, POINTER :: QCGIIRSfov(:) => NULL() ! GIIRSflags REAL, POINTER :: HIRS_Temp(:) => NULL() ! HIRS instrument temp (K) (atovs) REAL, POINTER :: AMSUa1_Temp(:) => NULL() ! AMSU-A1 instrument temp (K) (atovs) REAL, POINTER :: AMSUa2_Temp(:) => NULL() ! AMSU-A2 instrument temp (K) (atovs) @@ -851,7 +851,7 @@ MODULE OpsMod_ObsInfo TYPE (Element_type), POINTER :: WIND_SPED(:) => NULL() ! Surface windspeed m/s TYPE (Element_type), POINTER :: SeaHeight(:) => NULL() ! Height of Sea surface m TYPE (Element_type), POINTER :: SeaIce(:) => NULL() ! Sea ice - TYPE (Element_type), POINTER :: CHL(:) => NULL() ! mass concentration of chlorophyll a + TYPE (Element_type), POINTER :: CHL(:) => NULL() ! mass concentration of chlorophyll a ! in sea water milligram m-3 TYPE (Element_type), POINTER :: KD490(:) => NULL() ! volume attenuation coefficient of downwelling ! radiative flux in sea water at 490 nm\n m-1 @@ -859,7 +859,7 @@ MODULE OpsMod_ObsInfo TYPE (Element_type), POINTER :: Tskin(:) => NULL() ! Surface radiative temp. K TYPE (Element_type), POINTER :: TCWV(:) => NULL() ! Total Column Water Vapour kg/m^2 TYPE (Element_type), POINTER :: LWP(:) => NULL() ! Liquid Water Path kg/m^2 - TYPE (Element_type), POINTER :: IWP(:) => NULL() ! Ice Water Path kg/m^2 + TYPE (Element_type), POINTER :: IWP(:) => NULL() ! Ice Water Path kg/m^2 TYPE (Element_type), POINTER :: RetLWP(:) => NULL() ! retrieved Liquid Water Path kg/m^2 TYPE (Element_type), POINTER :: Rainrate(:,:) => NULL() ! Rain rate kg/m^2/s TYPE (Element_type), POINTER :: Snowrate(:,:) => NULL() ! Snow rate kg/m^2/s diff --git a/deps/ops/code/OpsMod_Utilities/Ops_PressureToHeight.f90 b/deps/ops/code/OpsMod_Utilities/Ops_PressureToHeight.f90 index ca187a66..92dc5b65 100644 --- a/deps/ops/code/OpsMod_Utilities/Ops_PressureToHeight.f90 +++ b/deps/ops/code/OpsMod_Utilities/Ops_PressureToHeight.f90 @@ -37,7 +37,7 @@ SUBROUTINE Ops_PressureToHeight (Pressures, & REAL, INTENT(IN) :: Pressures(Npoints)! Pressures (Pascals) to be converted ! Local declarations: -CHARACTER(len=*),PARAMETER :: RoutineName = 'Ops_PressureToHeight' +CHARACTER(len=*),PARAMETER :: RoutineName = "Ops_PressureToHeight" INTEGER :: I ! Loop variable REAL :: RepT_Bot ! Reciprical of bottom temperature REAL :: RepT_Top ! Reciprical of top temperature diff --git a/deps/ops/public/GenMod_Control/GenMod_Control.F90 b/deps/ops/public/GenMod_Control/GenMod_Control.F90 index 9de845fe..b294caa3 100755 --- a/deps/ops/public/GenMod_Control/GenMod_Control.F90 +++ b/deps/ops/public/GenMod_Control/GenMod_Control.F90 @@ -16,7 +16,7 @@ MODULE GenMod_Control IMPLICIT NONE INTEGER, PARAMETER :: LenDocumentationURL = 100 -CHARACTER(len=LenDocumentationURL) :: DocumentationURL = '.' +CHARACTER(len=LenDocumentationURL) :: DocumentationURL = "." LOGICAL :: ProduceHTML = .TRUE. INTEGER :: mype = 0 ! This processor's number: 0 <= mype < NPROC. INTEGER :: nproc = 1 ! Number of processors diff --git a/deps/ops/public/GenMod_Core/GenMod_Core.F90 b/deps/ops/public/GenMod_Core/GenMod_Core.F90 index 320247bb..e12bab1a 100644 --- a/deps/ops/public/GenMod_Core/GenMod_Core.F90 +++ b/deps/ops/public/GenMod_Core/GenMod_Core.F90 @@ -92,8 +92,8 @@ MODULE GenMod_Core REAL(kind=jprb), ALLOCATABLE :: dr_hook_handle_stack(:,:) INTEGER, ALLOCATABLE :: dr_hook_pointer(:) -CHARACTER(len=*), PARAMETER :: ColourWarning = 'maroon' ! colour: warning -CHARACTER(len=*), PARAMETER :: ColourFatal = 'red' ! colour: fatal error +CHARACTER(len=*), PARAMETER :: ColourWarning = "maroon" ! colour: warning +CHARACTER(len=*), PARAMETER :: ColourFatal = "red" ! colour: fatal error ! Error status codes known to the system are listed by name below. ! StatusOK StatusWarning and StatusFatal are for general use. diff --git a/deps/ops/public/GenMod_Platform/GenMod_Matmul.F90 b/deps/ops/public/GenMod_Platform/GenMod_Matmul.F90 index 1f6d8afc..72b89479 100755 --- a/deps/ops/public/GenMod_Platform/GenMod_Matmul.F90 +++ b/deps/ops/public/GenMod_Platform/GenMod_Matmul.F90 @@ -48,10 +48,10 @@ FUNCTION Gen_MATMUL_MM (A, & CALL DGEMUL (A, & ARG2, & - 'N', & + "N", & B, & ARG5, & - 'N', & + "N", & C, & ARG8, & ARG9, & diff --git a/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_FieldDataShared.f90 b/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_FieldDataShared.f90 index 43ada906..0c295ed1 100644 --- a/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_FieldDataShared.f90 +++ b/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_FieldDataShared.f90 @@ -6,10 +6,10 @@ ! ! Included in the module are two public routines: ! 1) OPS_InitFieldData - inilise and read the model state into memory -! Inputs: +! Inputs: ! domain: contains the infomation required to get the header data and read the ! fields. -! FieldsInfo: information about fields in UM dump, prepared in +! FieldsInfo: information about fields in UM dump, prepared in ! Ops_CXSetupArrays ! CxArrays: used to get the number of levels in each required field ! ForecastTimes: define the time slices to be read @@ -21,7 +21,7 @@ ! Included in the module are two private routines: ! 1) GetReqDims - used by OPS_InitFieldData to get the dimensions of the ! shared memory -! 2) ReadModelShared - used by OPS_InitFieldData to read the data into the +! 2) ReadModelShared - used by OPS_InitFieldData to read the data into the ! shared memory !------------------------------------------------------------------------------- diff --git a/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_SharedMemory.f90 b/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_SharedMemory.f90 index 13faaab2..c8dd37a2 100644 --- a/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_SharedMemory.f90 +++ b/deps/ops/stubs/OpsMod_CXGenerate/OpsMod_SharedMemory.f90 @@ -80,7 +80,7 @@ MODULE OpsMod_SharedMemory ! Routine to destroy SharedData - Final doesnt work currently PROCEDURE, PUBLIC :: DestroySharedData -END TYPE +END TYPE SharedMemory_type !------------------------------------------------------------------------------- ! Module parameters @@ -124,7 +124,7 @@ FUNCTION InitSharedMemory (FieldDims, & INTEGER :: WindowSize INTEGER :: ArraySize(ARRAY_RANK) CHARACTER(len=80) :: ErrMess -CHARACTER (len=*), PARAMETER :: RoutineName = 'InitSharedMemory' +CHARACTER (len=*), PARAMETER :: RoutineName = "InitSharedMemory" ALLOCATE (self % FieldDims(SIZE (FieldDims, DIM = 1), SIZE (FieldDims, DIM = 2), SIZE (FieldDims, DIM = 3))) self % FieldDims = FieldDims @@ -138,7 +138,7 @@ FUNCTION InitSharedMemory (FieldDims, & ArraySize(4) = 1 ! Read one time-slice per time ELSE ArraySize(4) = SIZE (FieldDims,3) ! Number of time-slices for all fields -ENDIF +END IF ! Setting up the shared memory CALL ops_mpl_comm_split_type (mpl_comm_world, & @@ -149,7 +149,7 @@ FUNCTION InitSharedMemory (FieldDims, & istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_comm_split_type, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) @@ -161,7 +161,7 @@ FUNCTION InitSharedMemory (FieldDims, & istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_comm_rank, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) @@ -174,7 +174,7 @@ FUNCTION InitSharedMemory (FieldDims, & istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_comm_size, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) @@ -189,7 +189,7 @@ FUNCTION InitSharedMemory (FieldDims, & END DO ! Output information about the number of PE's per node and the allocated size - WRITE (MessageOut, '(A,I0,A,F7.3,A)') "InitSharedMemory: this node has ", & + WRITE (MessageOut, "(A,I0,A,F7.3,A)") "InitSharedMemory: this node has ", & self % NProcNode ," PE's and is allocating ", & real(WindowSize) / real(2**30) ," GiB of shared memory" @@ -207,7 +207,7 @@ FUNCTION InitSharedMemory (FieldDims, & istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_win_allocate_shared, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) @@ -222,7 +222,7 @@ FUNCTION InitSharedMemory (FieldDims, & self % BasePtr, & istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_win_shared_query, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) @@ -332,12 +332,12 @@ FUNCTION GetData (self, & REAL(real32), POINTER :: FieldData(:,:) ! Local declarations: -CHARACTER (len=*), PARAMETER :: RoutineName = 'GetData(SharedMemory_type)' +CHARACTER (len=*), PARAMETER :: RoutineName = "GetData(SharedMemory_type)" INTEGER :: iTime_local IF (.NOT. self % is_instantiated) THEN CALL gen_fail (RoutineName, & - 'SharedMemory object is NOT instantiated') + "SharedMemory object is NOT instantiated") END IF ! If not reading all fields then reuse the first time slice @@ -405,7 +405,7 @@ SUBROUTINE DestroySharedData (self) CLASS (SharedMemory_type) :: self CHARACTER(len=80) :: ErrMess -CHARACTER (len=*), PARAMETER :: RoutineName = 'DestroySharedData' +CHARACTER (len=*), PARAMETER :: RoutineName = "DestroySharedData" IF (self % is_instantiated) THEN @@ -415,7 +415,7 @@ SUBROUTINE DestroySharedData (self) istat) IF (istat /= mpl_success) THEN - WRITE (ErrMess, '(A,I0,A,I0)') & + WRITE (ErrMess, "(A,I0,A,I0)") & "Error in ops_mpl_win_free, mype = ", mype, " istat = ", istat CALL gen_fail (RoutineName, & ErrMess) diff --git a/deps/ops/stubs/OpsMod_GroundGPS/OpsMod_GroundGPS.f90 b/deps/ops/stubs/OpsMod_GroundGPS/OpsMod_GroundGPS.f90 index a4d00347..2d72929f 100644 --- a/deps/ops/stubs/OpsMod_GroundGPS/OpsMod_GroundGPS.f90 +++ b/deps/ops/stubs/OpsMod_GroundGPS/OpsMod_GroundGPS.f90 @@ -20,7 +20,7 @@ MODULE OpsMod_GroundGPS ! Ground Based GNSS Zenith Total Delay. ! This is the newest version of the operator and is used in both the ! Global and the UKV model as of 04/05/2022. In operations this value -! is controlled in the ops_process_groundgps/rose-app.conf. +! is controlled in the ops_process_groundgps/rose-app.conf. INTEGER :: GroundGPSOperator = 2 diff --git a/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBOPSInterface.f90 b/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBOPSInterface.f90 index 51506cf9..d8382d61 100644 --- a/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBOPSInterface.f90 +++ b/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBOPSInterface.f90 @@ -249,7 +249,7 @@ MODULE OpsMod_ODBOPSInterface INTEGER :: rep_type_oceanwinds = 0 INTEGER :: rep_type_moored_buoy = 0 INTEGER :: rep_type_spire_gpsro = 0 -INTEGER :: rep_type_giirs_fy4a = 0 +INTEGER :: rep_type_giirs_fy4a = 0 INTEGER :: rep_type_emaddc = 0 INTEGER :: rep_type_goes_18_amv = 0 INTEGER :: rep_type_goes_19_amv = 0 diff --git a/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBTableInfo.f90 b/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBTableInfo.f90 index 8e7341d4..a62eec82 100644 --- a/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBTableInfo.f90 +++ b/deps/ops/stubs/OpsMod_ODB/OpsMod_ODBTableInfo.f90 @@ -69,7 +69,7 @@ MODULE OpsMod_ODBTableInfo INTEGER, ALLOCATABLE :: obslevels(:) REAL, ALLOCATABLE :: obsvertco_references(:) INTEGER, ALLOCATABLE :: obsvertco_types(:) -END TYPE +END TYPE Tables_type CHARACTER(len=*), PARAMETER :: body_flags(2) = ["datum_status", & "datum_event1"] diff --git a/deps/ops/stubs/OpsMod_ODB/OpsProg_CreateODB.f90 b/deps/ops/stubs/OpsMod_ODB/OpsProg_CreateODB.f90 index eaa8d2c0..9b704a63 100644 --- a/deps/ops/stubs/OpsMod_ODB/OpsProg_CreateODB.f90 +++ b/deps/ops/stubs/OpsMod_ODB/OpsProg_CreateODB.f90 @@ -173,13 +173,13 @@ PROGRAM OpsProg_CreateODB IF (GeneralMode >= QuietMode .AND. mype == 0) THEN - WRITE (MessageOut, '(A)') "=========================================" - WRITE (MessageOut, '(A)') "OpsProg_CreateODB : Execution starts" + WRITE (MessageOut, "(A)") "=========================================" + WRITE (MessageOut, "(A)") "OpsProg_CreateODB : Execution starts" date_time = OpsFn_DateTime_now () WRITE (MessageOut, "(A4,I2.2,A1,I2.2,A1,I2.2,A4,I2.2,A1,I2.2,A1,I4)") & "at ", date_time % hour, ":", date_time % minute, ":", date_time % second, & " on ", date_time % day, "/", date_time % month, "/", date_time % year - WRITE (MessageOut, '(A)') "=========================================" + WRITE (MessageOut, "(A)") "=========================================" END IF @@ -211,7 +211,7 @@ PROGRAM OpsProg_CreateODB CALL Ops_ReadCycleTime IF (mype == 0) THEN - WRITE (StatsOut, '(A,2(I2.2,A),I4.4,A,I2.2)') " " // TRIM (Runid) // " ",& + WRITE (StatsOut, "(A,2(I2.2,A),I4.4,A,I2.2)") " " // TRIM (Runid) // " ",& CycleTime(cycle_day), "/", CycleTime(cycle_month), "/", & CycleTime(cycle_year), " ", cycleTime(cycle_hour) END IF @@ -221,7 +221,7 @@ PROGRAM OpsProg_CreateODB IF (COUNT (obs_group_list /= IMDI) == 0) THEN CALL gen_warn (ProgName, & - 'No Observation types requested') + "No Observation types requested") GOTO 9999 END IF @@ -352,16 +352,16 @@ PROGRAM OpsProg_CreateODB END IF IF (mype == 0) THEN - WRITE (StatsOut, '(A)') & - ' --------------------------------------------------------------------' - StatsString = ' Total ' // TRIM (OpsFn_ObsourcetoString(MainObsource)) // ' ' // & - TRIM (OpsFn_ObsGroupNumToName(obs_group_list(i))) // ' obs ' - WRITE (StatsString(35:44), '(A2,I8)') '= ', & + WRITE (StatsOut, "(A)") & + " --------------------------------------------------------------------" + StatsString = " Total " // TRIM (OpsFn_ObsourcetoString(MainObsource)) // " " // & + TRIM (OpsFn_ObsGroupNumToName(obs_group_list(i))) // " obs " + WRITE (StatsString(35:44), "(A2,I8)") "= ", & SUM (TempMDBData % SubTypeData(:) % TotalNumObs) - WRITE (StatsOut, '(A)') TRIM (StatsString) - WRITE (StatsOut, '(A)') & - ' --------------------------------------------------------------------' - WRITE (StatsOut, '(A)') ' ' + WRITE (StatsOut, "(A)") TRIM (StatsString) + WRITE (StatsOut, "(A)") & + " --------------------------------------------------------------------" + WRITE (StatsOut, "(A)") " " END IF IF (TempMDBData % NumSubTypes > 0) THEN DEALLOCATE (TempMDBData % SubTypeData) @@ -396,13 +396,13 @@ PROGRAM OpsProg_CreateODB IF (GeneralMode >= QuietMode .AND. mype == 0) THEN - WRITE (MessageOut,'(A)') "=========================================" - WRITE (MessageOut,'(A)') "OpsProg_CreateODB ends normally" + WRITE (MessageOut,"(A)") "=========================================" + WRITE (MessageOut,"(A)") "OpsProg_CreateODB ends normally" date_time = OpsFn_DateTime_now () WRITE(MessageOut, "(A4,I2.2,A1,I2.2,A1,I2.2,A4,I2.2,A1,I2.2,A1,I4)") & "at ", date_time % hour, ":", date_time % minute, ":", date_time % second, & " on ", date_time % day, "/", date_time % month, "/", date_time % year - WRITE (MessageOut,'(A)') "=========================================" + WRITE (MessageOut,"(A)") "=========================================" END IF diff --git a/deps/ops/stubs/OpsMod_ODB/OpsProg_SimulObs.f90 b/deps/ops/stubs/OpsMod_ODB/OpsProg_SimulObs.f90 index e5f43c34..ead7f086 100644 --- a/deps/ops/stubs/OpsMod_ODB/OpsProg_SimulObs.f90 +++ b/deps/ops/stubs/OpsMod_ODB/OpsProg_SimulObs.f90 @@ -52,7 +52,7 @@ PROGRAM OpsProg_SimulObs REAL, ALLOCATABLE :: z(:) REAL :: rblank8 REAL :: mdi -CHARACTER(len=8), PARAMETER :: cblank8 = '' +CHARACTER(len=8), PARAMETER :: cblank8 = "" LOGICAL, ALLOCATABLE :: LL_offset(:) CHARACTER(len=300) :: messages(3) TYPE (arguments_type) :: args @@ -80,14 +80,14 @@ PROGRAM OpsProg_SimulObs !-- Open database ! ------------- -session % dbname = 'ECMA' +session % dbname = "ECMA" session % npools = 1 CALL ops_odb_open (session, & - 'NEW') + "NEW") !-- Loop over input files and fill appropriate database table -! When the same table appears multiple times, +! When the same table appears multiple times, ! increment the pool number (modulo npools) preset_num_rows = .FALSE. @@ -102,13 +102,13 @@ PROGRAM OpsProg_SimulObs in_data = .FALSE. num_constant_columns = 0 DO - READ (unit, '(A)', IOSTAT = iostat) buffer + READ (unit, "(A)", IOSTAT = iostat) buffer IF (iostat == 0) THEN - IF (buffer(1:1) == '#') THEN + IF (buffer(1:1) == "#") THEN tblname = buffer(2:) - ELSE IF (buffer(1:1) == '$') THEN + ELSE IF (buffer(1:1) == "$") THEN IF (buffer(2:INDEX (buffer, "=") - 1) == "rows") THEN - READ (buffer(INDEX (buffer, '=') + 1:), *) nrows + READ (buffer(INDEX (buffer, "=") + 1:), *) nrows END IF preset_num_rows = .TRUE. constant_rows_only = .TRUE. @@ -159,9 +159,9 @@ PROGRAM OpsProg_SimulObs in_data = .FALSE. constant_column_number = 0 DO - READ (unit, '(A)', IOSTAT = iostat) buffer + READ (unit, "(A)", IOSTAT = iostat) buffer IF (iostat == 0) THEN - IF (buffer(1:1) == '#' .OR. buffer(1:1) == '$') THEN + IF (buffer(1:1) == "#" .OR. buffer(1:1) == "$") THEN ELSE IF (INDEX (buffer, "=") > 0) THEN constant_column_number = constant_column_number + 1 constant_columns(constant_column_number) = buffer(1:INDEX (buffer, "=") - 1) @@ -182,7 +182,7 @@ PROGRAM OpsProg_SimulObs END IF END DO - IF (tblname(1:1) /= '@') tblname = '@' // TRIM (tblname) + IF (tblname(1:1) /= "@") tblname = "@" // TRIM (tblname) ncols_all = ops_odb_get_num_columns (session, tblname) @@ -199,15 +199,15 @@ PROGRAM OpsProg_SimulObs tblname, & ctype) - LL_offset(:) = cvar(:)(1:11) == 'LINKOFFSET(' + LL_offset(:) = cvar(:)(1:11) == "LINKOFFSET(" is_string(:) = .FALSE. - WHERE (ctype(:) == 'string') is_string(:) = .TRUE. + WHERE (ctype(:) == "string") is_string(:) = .TRUE. ALLOCATE (x(nrows,0:ncols_all)) x(:,:) = 0 rblank8 = TRANSFER (cblank8,rblank8) DO j = 1, ncols_all - IF (ctype(j) == 'string') THEN + IF (ctype(j) == "string") THEN DO i = 1, nrows x(i,j) = rblank8 END DO @@ -228,8 +228,8 @@ PROGRAM OpsProg_SimulObs mdi = session % odb_mdi IF (ANY (colmap(:) < 0 .OR. colmap(:) > ncols_all)) THEN - WRITE (messages(1), '(A,I0,A)') 'Error: Some column ids out of range [1:',ncols_all,']' - CALL gen_fail ('MAIN', & + WRITE (messages(1), "(A,I0,A)") "Error: Some column ids out of range [1:",ncols_all,"]" + CALL gen_fail ("MAIN", & messages(1)) END IF @@ -250,7 +250,7 @@ PROGRAM OpsProg_SimulObs IF (.NOT. constant_rows_only) THEN ALLOCATE (z(ncols_all)) ! temporary buffer DO i = 1, nrows - READ (unit, '(A)') buffer + READ (unit, "(A)") buffer buffer = ADJUSTL (buffer) i_prev = 1 k = 1 @@ -258,13 +258,13 @@ PROGRAM OpsProg_SimulObs DO j = 1, LEN_TRIM (buffer) IF (buffer(j:j) == "") THEN IF (buffer(j + 1:j + 1) == "") CYCLE - IF (ADJUSTL (buffer(i_prev:i_prev + 7)) == 'NULL') THEN + IF (ADJUSTL (buffer(i_prev:i_prev + 7)) == "NULL") THEN z(k) = mdi ELSE IF (is_string(ABS (colmap(k)))) THEN READ (buffer(i_prev:i_prev + 7), *) char_tmp z(k) = TRANSFER (ADJUSTR (char_tmp), z(k)) ELSE IF (INDEX (buffer(i_prev:j), "b") > 0) THEN - READ (buffer(i_prev + INDEX (buffer(i_prev:), "b"):j), '(B32)') io_tmp + READ (buffer(i_prev + INDEX (buffer(i_prev:), "b"):j), "(B32)") io_tmp z(k) = io_tmp ELSE READ (buffer(i_prev:j), *) z(k) @@ -273,13 +273,13 @@ PROGRAM OpsProg_SimulObs i_prev = j END IF END DO - IF (ADJUSTL (buffer(i_prev:)) == 'NULL') THEN + IF (ADJUSTL (buffer(i_prev:)) == "NULL") THEN z(k) = mdi ELSE IF (is_string(ABS (colmap(k)))) THEN READ (buffer(i_prev:), *) char_tmp z(k) = TRANSFER (ADJUSTR (char_tmp), z(k)) ELSE IF (INDEX (buffer(i_prev:), "b") > 0) THEN - READ (buffer(i_prev + INDEX (buffer(i_prev:), "b"):), '(B32)') io_tmp + READ (buffer(i_prev + INDEX (buffer(i_prev:), "b"):), "(B32)") io_tmp z(k) = io_tmp ELSE READ (buffer(i_prev:), *) z(k) @@ -296,7 +296,7 @@ PROGRAM OpsProg_SimulObs k = 0 DO i = 1, nrows x(i,j) = k - k = k + x(i,j + 1) + k = k + x(i,j + 1) END DO END IF END DO diff --git a/deps/ops/stubs/Ops_Constants/OpsMod_Constants.f90 b/deps/ops/stubs/Ops_Constants/OpsMod_Constants.f90 index 0c909ef0..dd4963da 100644 --- a/deps/ops/stubs/Ops_Constants/OpsMod_Constants.f90 +++ b/deps/ops/stubs/Ops_Constants/OpsMod_Constants.f90 @@ -64,6 +64,6 @@ MODULE OpsMod_Constants 133.96, 135.26, 136.58, 137.90, 139.23, & 140.57, 141.92, 143.27, 144.64, 146.02, 147.40 ] -CHARACTER(len=16), PARAMETER :: CMDI = 'XXXXXXXX' +CHARACTER(len=16), PARAMETER :: CMDI = "XXXXXXXX" END MODULE OpsMod_Constants diff --git a/deps/ops/stubs/Ops_Constants/OpsMod_Kinds.F90 b/deps/ops/stubs/Ops_Constants/OpsMod_Kinds.F90 index 3ff6d90e..bb09ade2 100755 --- a/deps/ops/stubs/Ops_Constants/OpsMod_Kinds.F90 +++ b/deps/ops/stubs/Ops_Constants/OpsMod_Kinds.F90 @@ -12,15 +12,22 @@ MODULE OpsMod_Kinds #define HAVE_ISO_FORTRAN_ENV_INT8 1 #endif -USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: & #ifdef HAVE_ISO_FORTRAN_ENV_INT8 +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: & int8, & -#endif int16, & int32, & int64, & real32, & real64 +#else +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: & + int16, & + int32, & + int64, & + real32, & + real64 +#endif #endif diff --git a/src/opsinputs/CxWriter.interface.F90 b/src/opsinputs/CxWriter.interface.F90 index 7728fb0d..207cd04a 100644 --- a/src/opsinputs/CxWriter.interface.F90 +++ b/src/opsinputs/CxWriter.interface.F90 @@ -40,7 +40,7 @@ module opsinputs_cxwriter_mod_c !> Creates an opsinputs_cxwriter object. Returns 1 if the creation succeeds and 0 if it fails. function opsinputs_cxwriter_create_c(c_self, c_conf, c_varlist) & - bind(c,name='opsinputs_cxwriter_create_f90') + bind(c,name="opsinputs_cxwriter_create_f90") implicit none integer(c_int), intent(inout) :: c_self type(c_ptr), value, intent(in) :: c_conf @@ -66,7 +66,7 @@ end function opsinputs_cxwriter_create_c ! ------------------------------------------------------------------------------ subroutine opsinputs_cxwriter_delete_c(c_self) & - bind(c,name='opsinputs_cxwriter_delete_f90') + bind(c,name="opsinputs_cxwriter_delete_f90") implicit none integer(c_int), intent(inout) :: c_self @@ -81,7 +81,7 @@ end subroutine opsinputs_cxwriter_delete_c ! ------------------------------------------------------------------------------ subroutine opsinputs_cxwriter_prior_c(c_self, c_obspace, c_geovals) & - bind(c,name='opsinputs_cxwriter_prior_f90') + bind(c,name="opsinputs_cxwriter_prior_f90") implicit none integer(c_int), intent(in) :: c_self type(c_ptr), value, intent(in) :: c_obspace @@ -101,7 +101,7 @@ end subroutine opsinputs_cxwriter_prior_c subroutine opsinputs_cxwriter_post_c(c_self, c_obspace, c_geovals, c_flags, & c_nvars, c_nlocs, c_varnames, c_hofx) & - bind(c,name='opsinputs_cxwriter_post_f90') + bind(c,name="opsinputs_cxwriter_post_f90") implicit none integer(c_int), intent(in) :: c_self type(c_ptr), value, intent(in) :: c_obspace diff --git a/src/opsinputs/VarObsWriter.interface.F90 b/src/opsinputs/VarObsWriter.interface.F90 index eb4bd6ff..849ae3fe 100644 --- a/src/opsinputs/VarObsWriter.interface.F90 +++ b/src/opsinputs/VarObsWriter.interface.F90 @@ -42,9 +42,9 @@ module opsinputs_varobswriter_mod_c function opsinputs_varobswriter_create_c(c_self, c_conf, c_comm_is_valid, c_comm, & c_nchannels, c_channels, & c_varlist, c_varlist_diags) & - bind(c,name='opsinputs_varobswriter_create_f90') -use oops_variables_mod -use obs_variables_mod + bind(c,name="opsinputs_varobswriter_create_f90") +use oops_variables_mod, only: oops_variables +use obs_variables_mod, only: obs_variables implicit none integer(c_int), intent(inout) :: c_self type(c_ptr), value, intent(in) :: c_conf @@ -82,7 +82,7 @@ end function opsinputs_varobswriter_create_c ! ------------------------------------------------------------------------------ subroutine opsinputs_varobswriter_delete_c(c_self) & - bind(c,name='opsinputs_varobswriter_delete_f90') + bind(c,name="opsinputs_varobswriter_delete_f90") implicit none integer(c_int), intent(inout) :: c_self @@ -97,7 +97,7 @@ end subroutine opsinputs_varobswriter_delete_c ! ------------------------------------------------------------------------------ subroutine opsinputs_varobswriter_prior_c(c_self, c_obspace, c_geovals) & - bind(c,name='opsinputs_varobswriter_prior_f90') + bind(c,name="opsinputs_varobswriter_prior_f90") implicit none integer(c_int), intent(in) :: c_self type(c_ptr), value, intent(in) :: c_obspace @@ -117,7 +117,7 @@ end subroutine opsinputs_varobswriter_prior_c subroutine opsinputs_varobswriter_post_c(c_self, c_obspace, c_flags, c_obserrors, & c_nvars, c_nlocs, c_hofx, c_obsdiags) & - bind(c,name='opsinputs_varobswriter_post_f90') + bind(c,name="opsinputs_varobswriter_post_f90") implicit none integer(c_int), intent(in) :: c_self type(c_ptr), value, intent(in) :: c_obspace diff --git a/src/opsinputs/opsinputs_cxgenerate_mod.F90 b/src/opsinputs/opsinputs_cxgenerate_mod.F90 index 2608986a..9504afb8 100644 --- a/src/opsinputs/opsinputs_cxgenerate_mod.F90 +++ b/src/opsinputs/opsinputs_cxgenerate_mod.F90 @@ -8,6 +8,7 @@ module opsinputs_cxgenerate_mod implicit none +public integer :: CxLevels = 30 integer, parameter :: MaxModelCodes = 100 diff --git a/src/opsinputs/opsinputs_cxwriter_mod.F90 b/src/opsinputs/opsinputs_cxwriter_mod.F90 index a4a5796d..1f0b7cce 100644 --- a/src/opsinputs/opsinputs_cxwriter_mod.F90 +++ b/src/opsinputs/opsinputs_cxwriter_mod.F90 @@ -173,7 +173,7 @@ module opsinputs_cxwriter_mod real(real64), allocatable :: EtaTheta(:) real(real64), allocatable :: EtaRho( :) - type(ufo_geovals), pointer :: GeoVals + type(ufo_geovals), pointer :: GeoVals => null() type(opsinputs_jeditoopslayoutmapping) :: JediToOpsLayoutMapping type(obs_variables) :: varnames real(c_double), pointer :: hofx(:, :) @@ -772,7 +772,7 @@ subroutine opsinputs_cxwriter_addrequiredgeovars(self, geovars) case (StashItem_dustMin:StashItem_dustMax) ! IndexCxDust1:6 DustBinIndex = CxField - StashItem_dustMin + 1 if (DustBinIndex <= NDustBins) then - write (DustBinIndexStr, '(i1)') DustBinIndex + write (DustBinIndexStr, "(i1)") DustBinIndex GeoVarName = opsinputs_cxfields_dustp_start // DustBinIndexStr // opsinputs_cxfields_dustp_end end if case default @@ -1270,7 +1270,7 @@ subroutine opsinputs_cxwriter_populatecx(self, ReportFlags, Cx) case (StashItem_dustMin:StashItem_dustMax) ! IndexCxDust1:IndexCxDust6 DustBinIndex = CxField - StashItem_dustMin + 1 if (DustBinIndex <= NDustBins) then - write (DustBinIndexStr, '(i1)') DustBinIndex + write (DustBinIndexStr, "(i1)") DustBinIndex call opsinputs_fill_fillreal2dfromgeovalorhofx( & Cx % Header % dustp, "dustp", Cx % dustp(DustBinIndex) % field, & self % GeoVals, self % GeoVaLsAreTopToBottom, & diff --git a/src/opsinputs/opsinputs_fill_mod.F90 b/src/opsinputs/opsinputs_fill_mod.F90 index 411cdb14..6a409f56 100644 --- a/src/opsinputs/opsinputs_fill_mod.F90 +++ b/src/opsinputs/opsinputs_fill_mod.F90 @@ -168,7 +168,7 @@ subroutine opsinputs_fill_fillelementtypefromsimulatedvariable( & if (opsinputs_obsdatavector_int_has(Flags, JediVarName)) then call opsinputs_obsdatavector_int_get(Flags, JediVarName, Flag) else - write (ErrorMessage, '(A,A)') "QC flags not found for variable ", JediVarName + write (ErrorMessage, "(A,A)") "QC flags not found for variable ", JediVarName call gen_warn(RoutineName, ErrorMessage) Flag(:) = 0 ! assume all observations passed QC end if @@ -176,7 +176,7 @@ subroutine opsinputs_fill_fillelementtypefromsimulatedvariable( & if (opsinputs_obsdatavector_float_has(ObsErrors, JediVarName)) then call opsinputs_obsdatavector_float_get(ObsErrors, JediVarName, ObsError) else - write (ErrorMessage, '(A,A,A)') "Variable ObsError/", JediVarName, " not found" + write (ErrorMessage, "(A,A,A)") "Variable ObsError/", JediVarName, " not found" call gen_warn(RoutineName, ErrorMessage) ObsError(:) = MissingFloat end if @@ -302,7 +302,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_norecords( & if (opsinputs_obsdatavector_int_has(Flags, JediVarNamesWithChannels(iChannel))) then call opsinputs_obsdatavector_int_get(Flags, JediVarNamesWithChannels(iChannel), Flag) else - write (ErrorMessage, '(A,A,A)') & + write (ErrorMessage, "(A,A,A)") & "Warning: variable ", JediVarNamesWithChannels(iChannel), " QC flags not found" call gen_warn(RoutineName, ErrorMessage) Flag(:) = 0 ! assume all observations passed QC @@ -311,7 +311,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_norecords( & if (opsinputs_obsdatavector_float_has(ObsErrors, JediVarNamesWithChannels(iChannel))) then call opsinputs_obsdatavector_float_get(ObsErrors, JediVarNamesWithChannels(iChannel), ObsError) else - write (ErrorMessage, '(A,A,A)') & + write (ErrorMessage, "(A,A,A)") & "Warning: variable ObsError/", JediVarNamesWithChannels(iChannel), " not found" call gen_warn(RoutineName, ErrorMessage) ObsError(:) = MissingFloat @@ -432,7 +432,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_records( & if (opsinputs_obsdatavector_int_has(Flags, JediVarName)) then call opsinputs_obsdatavector_int_get(Flags, JediVarName, Flag) else - write (ErrorMessage, '(A,A,A)') & + write (ErrorMessage, "(A,A,A)") & "Warning: variable ", JediVarName, " QC flags not found" call gen_warn(RoutineName, ErrorMessage) Flag(:) = 0 ! assume all observations passed QC @@ -441,7 +441,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_records( & if (opsinputs_obsdatavector_float_has(ObsErrors, JediVarName)) then call opsinputs_obsdatavector_float_get(ObsErrors, JediVarName, ObsError) else - write (ErrorMessage, '(A,A,A)') & + write (ErrorMessage, "(A,A,A)") & "Warning: variable ObsError/", JediVarName, " not found" call gen_warn(RoutineName, ErrorMessage) ObsError(:) = MissingFloat @@ -629,7 +629,7 @@ subroutine opsinputs_fill_fillelementtypefromnormalvariable( & ! Body: if (present(JediErrorVarName) .neqv. present(JediErrorGroup)) then - write (ErrorMessage, '(A)') & + write (ErrorMessage, "(A)") & "JediErrorVarName and JediErrorGroup must be either both absent or both present" call gen_warn(RoutineName, ErrorMessage) end if @@ -746,7 +746,7 @@ subroutine opsinputs_fill_fillelementtype2dfromnormalvariable( & ! Body: if (present(JediErrorVarName) .neqv. present(JediErrorGroup)) then - write (ErrorMessage, '(A)') & + write (ErrorMessage, "(A)") & "JediErrorVarName and JediErrorGroup must be either both absent or both present" call gen_warn(RoutineName, ErrorMessage) end if @@ -873,7 +873,7 @@ subroutine opsinputs_fill_fillelementtype2dfromnormalvariablewithlevels( & ! Body: if (present(JediErrorVarName) .neqv. present(JediErrorGroup)) then - write (ErrorMessage, '(A)') & + write (ErrorMessage, "(A)") & "JediErrorVarName and JediErrorGroup must be either both absent or both present" call gen_warn(RoutineName, ErrorMessage) end if @@ -1118,8 +1118,8 @@ subroutine opsinputs_fill_fillreal2d_norecords( & else arrayindex = varChannels(iChannel) end if - else - exit + else + exit end if else if (.not. compressChannels) then @@ -2540,7 +2540,7 @@ function opsinputs_fill_varnames_with_levels(VarName, Levels) result(VarNames) VarNames(1) = VarName else do ilev = 1, size(Levels) - write (VarNames(ilev),'(A,I0)') VarName, Levels(ilev) + write (VarNames(ilev),"(A,I0)") VarName, Levels(ilev) end do end if end function opsinputs_fill_varnames_with_levels diff --git a/src/opsinputs/opsinputs_mpl_mod.F90 b/src/opsinputs/opsinputs_mpl_mod.F90 index e31c4b04..81dddc67 100644 --- a/src/opsinputs/opsinputs_mpl_mod.F90 +++ b/src/opsinputs/opsinputs_mpl_mod.F90 @@ -6,6 +6,7 @@ module opsinputs_mpl_mod implicit none +public ! ------------------------------------------------------------------------------ contains diff --git a/src/opsinputs/opsinputs_obsdatavector_interface.f90 b/src/opsinputs/opsinputs_obsdatavector_interface.f90 index a65a4d18..3c92c4e0 100644 --- a/src/opsinputs/opsinputs_obsdatavector_interface.f90 +++ b/src/opsinputs/opsinputs_obsdatavector_interface.f90 @@ -7,7 +7,7 @@ interface integer(kind=c_int) function c_opsinputs_obsdatavector_int_nlocs(vec) & - bind(C,name='opsinputs_obsdatavector_int_nlocs_f') + bind(C,name="opsinputs_obsdatavector_int_nlocs_f") use, intrinsic :: iso_c_binding, only: c_int, c_ptr implicit none @@ -15,14 +15,14 @@ integer(kind=c_int) function c_opsinputs_obsdatavector_int_nlocs(vec) & end function c_opsinputs_obsdatavector_int_nlocs type(c_ptr) function c_opsinputs_obsdatavector_int_varnames(vec) & - bind(C, name='opsinputs_obsdatavector_int_varnames_f') + bind(C, name="opsinputs_obsdatavector_int_varnames_f") use, intrinsic :: iso_c_binding, only: c_ptr implicit none type(c_ptr), value :: vec end function c_opsinputs_obsdatavector_int_varnames logical(kind=c_bool) function c_opsinputs_obsdatavector_int_has(vec, variable) & - bind(C,name='opsinputs_obsdatavector_int_has_f') + bind(C,name="opsinputs_obsdatavector_int_has_f") use, intrinsic :: iso_c_binding, only: c_bool, c_char, c_ptr implicit none @@ -31,7 +31,7 @@ logical(kind=c_bool) function c_opsinputs_obsdatavector_int_has(vec, variable) & end function c_opsinputs_obsdatavector_int_has subroutine c_opsinputs_obsdatavector_int_get(vec, variable, length, data) & - bind(C,name='opsinputs_obsdatavector_int_get_f') + bind(C,name="opsinputs_obsdatavector_int_get_f") use, intrinsic :: iso_c_binding, only : c_char, c_int, c_ptr, c_size_t implicit none type(c_ptr), value :: vec @@ -41,7 +41,7 @@ subroutine c_opsinputs_obsdatavector_int_get(vec, variable, length, data) & end subroutine c_opsinputs_obsdatavector_int_get integer(kind=c_int) function c_opsinputs_obsdatavector_float_nlocs(vec) & - bind(C,name='opsinputs_obsdatavector_float_nlocs_f') + bind(C,name="opsinputs_obsdatavector_float_nlocs_f") use, intrinsic :: iso_c_binding, only: c_int, c_ptr implicit none @@ -49,14 +49,14 @@ integer(kind=c_int) function c_opsinputs_obsdatavector_float_nlocs(vec) & end function c_opsinputs_obsdatavector_float_nlocs type(c_ptr) function c_opsinputs_obsdatavector_float_varnames(vec) & - bind(C, name='opsinputs_obsdatavector_float_varnames_f') + bind(C, name="opsinputs_obsdatavector_float_varnames_f") use, intrinsic :: iso_c_binding, only: c_ptr implicit none type(c_ptr), value :: vec end function c_opsinputs_obsdatavector_float_varnames logical(kind=c_bool) function c_opsinputs_obsdatavector_float_has(vec, variable) & - bind(C,name='opsinputs_obsdatavector_float_has_f') + bind(C,name="opsinputs_obsdatavector_float_has_f") use, intrinsic :: iso_c_binding, only: c_bool, c_char, c_ptr implicit none @@ -65,7 +65,7 @@ logical(kind=c_bool) function c_opsinputs_obsdatavector_float_has(vec, variable) end function c_opsinputs_obsdatavector_float_has subroutine c_opsinputs_obsdatavector_float_get(vec, variable, length, data) & - bind(C,name='opsinputs_obsdatavector_float_get_f') + bind(C,name="opsinputs_obsdatavector_float_get_f") use, intrinsic :: iso_c_binding, only : c_char, c_float, c_ptr, c_size_t implicit none type(c_ptr), value :: vec diff --git a/src/opsinputs/opsinputs_obsdatavector_mod.F90 b/src/opsinputs/opsinputs_obsdatavector_mod.F90 index f24d7344..b1743153 100644 --- a/src/opsinputs/opsinputs_obsdatavector_mod.F90 +++ b/src/opsinputs/opsinputs_obsdatavector_mod.F90 @@ -40,7 +40,6 @@ end function opsinputs_obsdatavector_int_nlocs type(obs_variables) function opsinputs_obsdatavector_int_varnames(c_vec) !use, intrinsic :: iso_c_binding, only: c_ptr - !use obs_variables_mod implicit none type(c_ptr), value, intent(in) :: c_vec @@ -95,7 +94,6 @@ end function opsinputs_obsdatavector_float_nlocs type(obs_variables) function opsinputs_obsdatavector_float_varnames(c_vec) !use, intrinsic :: iso_c_binding - use obs_variables_mod implicit none type(c_ptr), value, intent(in) :: c_vec diff --git a/src/opsinputs/opsinputs_obsspace_interface.f90 b/src/opsinputs/opsinputs_obsspace_interface.f90 index 786f7afd..cb65dc86 100644 --- a/src/opsinputs/opsinputs_obsspace_interface.f90 +++ b/src/opsinputs/opsinputs_obsspace_interface.f90 @@ -8,7 +8,7 @@ subroutine c_opsinputs_obsspace_get_db_datetime_offset_in_seconds( & obss, group, variable, reference, length, offsets) & - bind(C,name='opsinputs_obsspace_get_db_datetime_offset_in_seconds_f') + bind(C,name="opsinputs_obsspace_get_db_datetime_offset_in_seconds_f") use, intrinsic :: iso_c_binding, only: c_char, c_int64_t, c_ptr, c_size_t implicit none type(c_ptr), value :: obss @@ -21,7 +21,7 @@ end subroutine c_opsinputs_obsspace_get_db_datetime_offset_in_seconds subroutine c_opsinputs_obsspace_get_db_string( & obss, group, variable, string_length, num_strings, characters) & - bind(C,name='opsinputs_obsspace_get_db_string_f') + bind(C,name="opsinputs_obsspace_get_db_string_f") use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_size_t implicit none type(c_ptr), value :: obss @@ -34,7 +34,7 @@ end subroutine c_opsinputs_obsspace_get_db_string subroutine c_opsinputs_obsspace_get_locs_ordered_by_record( & obss, NumLocations, LocationsOrderedByRecord, NumRecordStarts, RecordStarts) & - bind(C,name='opsinputs_obsspace_get_locs_ordered_by_record_f') + bind(C,name="opsinputs_obsspace_get_locs_ordered_by_record_f") use, intrinsic :: iso_c_binding, only: c_ptr, c_int32_t implicit none type(c_ptr), value :: obss diff --git a/src/opsinputs/opsinputs_obsspace_mod.F90 b/src/opsinputs/opsinputs_obsspace_mod.F90 index 89a83327..56d4edba 100644 --- a/src/opsinputs/opsinputs_obsspace_mod.F90 +++ b/src/opsinputs/opsinputs_obsspace_mod.F90 @@ -22,7 +22,7 @@ module opsinputs_obsspace_mod !> Get a datetime variable from ObsSpace, representing it as an array of offsets (in seconds) !> with respect to a reference datetime. subroutine opsinputs_obsspace_get_db_datetime_offset_in_seconds(obss, group, vname, reference, offsets) - use, intrinsic :: iso_c_binding + use, intrinsic :: iso_c_binding, only: c_char, c_int64_t, c_ptr, c_size_t implicit none type(c_ptr), value, intent(in) :: obss character(len=*), intent(in) :: group @@ -46,7 +46,7 @@ end subroutine opsinputs_obsspace_get_db_datetime_offset_in_seconds !> Get a string variable from ObsSpace. subroutine opsinputs_obsspace_get_db_string(obss, group, vname, string_length, strings) - use, intrinsic :: iso_c_binding + use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_size_t implicit none type(c_ptr), value, intent(in) :: obss character(len=*), intent(in) :: group @@ -79,7 +79,7 @@ end subroutine opsinputs_obsspace_get_db_string !> elements of `LocationsOrderedByRecord` storing the first location of each record. subroutine opsinputs_obsspace_get_locs_ordered_by_record(obss, & LocationsOrderedByRecord, RecordStarts) - use, intrinsic :: iso_c_binding + use, intrinsic :: iso_c_binding, only: c_int32_t, c_ptr implicit none type(c_ptr), value, intent(in) :: obss integer(c_int32_t), intent(inout) :: LocationsOrderedByRecord(:) diff --git a/src/opsinputs/opsinputs_varobswriter_mod.F90 b/src/opsinputs/opsinputs_varobswriter_mod.F90 index c7c5d5cc..62aede88 100644 --- a/src/opsinputs/opsinputs_varobswriter_mod.F90 +++ b/src/opsinputs/opsinputs_varobswriter_mod.F90 @@ -199,12 +199,12 @@ module opsinputs_varobswriter_mod logical :: compressVarChannels logical :: increaseChanArray - + !this stores the atmospheric levels we wish to pass to varobs - integer(c_int), allocatable :: modlevs(:) - - type(ufo_geovals), pointer :: GeoVals - type(ufo_geovals), pointer :: ObsDiags + integer(c_int), allocatable :: modlevs(:) + + type(ufo_geovals), pointer :: GeoVals => null() + type(ufo_geovals), pointer :: ObsDiags => null() end type opsinputs_varobswriter ! ------------------------------------------------------------------------------ @@ -501,7 +501,7 @@ function opsinputs_varobswriter_create(self, f_conf, comm_is_valid, comm, channe allocate(self % modlevs(self % IC_PLevels)) do ilev = 1, self % IC_PLevels self % modlevs(ilev) = ilev -enddo +end do ! Fill in the list of variables that will be needed to populate the requested varfields. call opsinputs_varobswriter_addrequiredgeovars(self, geovars) @@ -1209,7 +1209,7 @@ subroutine opsinputs_varobswriter_populateobservations( & ! TODO(someone): handle this varfield ! call Ops_Alloc(Ob % Header % HeightCOG, "HeightCOG", Ob % Header % NumObsLocal, Ob % HeightCOG) case default - write (ErrorMessage, '(A,I0)') "VarField code not recognised ", VarFields(iVarField) + write (ErrorMessage, "(A,I0)") "VarField code not recognised ", VarFields(iVarField) call gen_warn(RoutineName, ErrorMessage) cycle end select @@ -1260,7 +1260,7 @@ end subroutine opsinputs_varobswriter_fillreportflags !> Ob % ChanNum is filled with the indices of channels that passed QC; !> an optional offset to the channel number can be added. This is !> sometimes required when multiple instruments are packed together -!> e.g. for HIRS & AMSUA +!> e.g. for HIRS & AMSUA !> the number of these channels is stored in Ob % NumChans. subroutine opsinputs_varobswriter_fillchannumandnumchans( & Ob, ObsSpace, channels, varChannels, Flags, FillChanNum, FillNumChans, compressVarChannels, & @@ -1509,7 +1509,7 @@ end subroutine opsinputs_varobswriter_fillsatid !> Fill the Ob % BiasPredictor field. !> -!> This is done in a separate routine because this field is filled from +!> This is done in a separate routine because this field is filled from !> several arrays in the Obs Space and there is some data manipulation subroutine opsinputs_varobswriter_fillpredictors( & Hdr, OpsVarName, NumObs, Real2, ObsSpace, Channels, JediVarName) From 930a98996d77d025bb239aef7d135e575dee51e8 Mon Sep 17 00:00:00 2001 From: Matt Shin Date: Mon, 18 May 2026 17:48:37 +0100 Subject: [PATCH 2/2] Fortitude 0.9 happiness alt 2 --- .fortitude.toml | 6 +++++ .github/workflows/ci.yml | 10 ++++---- src/opsinputs/opsinputs_cxwriter_mod.F90 | 4 ++-- src/opsinputs/opsinputs_fill_mod.F90 | 24 ++++++++++---------- src/opsinputs/opsinputs_varobswriter_mod.F90 | 6 ++--- 5 files changed, 29 insertions(+), 21 deletions(-) diff --git a/.fortitude.toml b/.fortitude.toml index 0d85b107..f373a8e3 100644 --- a/.fortitude.toml +++ b/.fortitude.toml @@ -28,6 +28,12 @@ line-length=140 "C061", # missing-intent "C091", # external-procedure ] +"src/opsinputs/opsinputs_obsdatavector_interface.f90" = [ + "C071", # assumed-size +] +"src/opsinputs/opsinputs_obsspace_interface.f90" = [ + "C071", # assumed-size +] "src/opsinputs/opsinputs_varobswriter_mod.F90" = [ "C091", # external-procedure "C121", # use-all diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 23a45049..59943ae0 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -24,18 +24,20 @@ permissions: contents: read jobs: - lint: - name: Lint CMakeLists + checks: runs-on: ubuntu-latest steps: - uses: actions/checkout@v5 - name: Install cmakelint run: | - python3 -m pip install cmakelint - - name: Lint + python3 -m pip install cmakelint fortitude-lint + - name: Run cmakelint run: | find -type f '(' -name 'CMakeLists.txt' -o -name '*.cmake' ')' \ -exec cmakelint '{}' ';' + - name: Run fortitude check + run: | + fortitude check --target-std=f2008 --line-length=150 build: name: gnu-openmpi diff --git a/src/opsinputs/opsinputs_cxwriter_mod.F90 b/src/opsinputs/opsinputs_cxwriter_mod.F90 index 1f0b7cce..ea20f16c 100644 --- a/src/opsinputs/opsinputs_cxwriter_mod.F90 +++ b/src/opsinputs/opsinputs_cxwriter_mod.F90 @@ -1311,8 +1311,8 @@ subroutine opsinputs_cxwriter_unrotatewinds(self, Ob, Cx) real(real64), allocatable :: Vunrot(:) ! Array for unrotated wind v component real(real64), allocatable :: U10unrot(:) ! Array for unrotated wind u10 component real(real64), allocatable :: V10unrot(:) ! Array for unrotated wind v10 component -logical :: UpperWinds = .false. ! Upper air wind u and v components present -logical :: SurfaceWinds = .false. ! Surface wind u and v components present +logical, save :: UpperWinds = .false. ! Upper air wind u and v components present +logical, save :: SurfaceWinds = .false. ! Surface wind u and v components present ! Body: call Ops_ReadCXControlNL(self % obsgroup, CxFields, BGECall = .false._8, ops_call = .false._8) diff --git a/src/opsinputs/opsinputs_fill_mod.F90 b/src/opsinputs/opsinputs_fill_mod.F90 index 6a409f56..bd4b0d6b 100644 --- a/src/opsinputs/opsinputs_fill_mod.F90 +++ b/src/opsinputs/opsinputs_fill_mod.F90 @@ -122,7 +122,7 @@ subroutine opsinputs_fill_fillelementtypefromsimulatedvariable( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(Element_type), pointer :: El1(:) +type(Element_type), pointer, intent(inout) :: El1(:) type(c_ptr), value, intent(in) :: ObsSpace type(c_ptr), value, intent(in) :: Flags type(c_ptr), value, intent(in) :: ObsErrors @@ -246,7 +246,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_norecords( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(Element_type), pointer :: El2(:,:) +type(Element_type), pointer, intent(inout) :: El2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) type(c_ptr), value, intent(in) :: Flags @@ -377,7 +377,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable_records( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping -type(Element_type), pointer :: El2(:,:) +type(Element_type), pointer, intent(inout) :: El2(:,:) type(c_ptr), value, intent(in) :: ObsSpace type(c_ptr), value, intent(in) :: Flags type(c_ptr), value, intent(in) :: ObsErrors @@ -538,7 +538,7 @@ subroutine opsinputs_fill_fillelementtype2dfromsimulatedvariable( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping -type(Element_type), pointer :: El2(:,:) +type(Element_type), pointer, intent(inout) :: El2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) type(c_ptr), value, intent(in) :: Flags @@ -607,7 +607,7 @@ subroutine opsinputs_fill_fillelementtypefromnormalvariable( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(Element_type), pointer :: El1(:) +type(Element_type), pointer, intent(inout) :: El1(:) type(c_ptr), value, intent(in) :: ObsSpace character(len=*), intent(in) :: JediValueVarName character(len=*), intent(in) :: JediValueGroup @@ -720,7 +720,7 @@ subroutine opsinputs_fill_fillelementtype2dfromnormalvariable( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(Element_type), pointer :: El2(:,:) +type(Element_type), pointer, intent(inout) :: El2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) character(len=*), intent(in) :: JediValueVarName @@ -850,7 +850,7 @@ subroutine opsinputs_fill_fillelementtype2dfromnormalvariablewithlevels( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(Element_type), pointer :: El2(:,:) +type(Element_type), pointer, intent(inout) :: El2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Levels(:) character(len=*), intent(in) :: JediValueVarName @@ -1795,7 +1795,7 @@ subroutine opsinputs_fill_fillinteger( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping -integer(integer64), pointer :: Int1(:) +integer(integer64), pointer, intent(inout) :: Int1(:) type(c_ptr), value, intent(in) :: ObsSpace character(len=*), intent(in) :: JediVarName character(len=*), intent(in) :: JediVarGroup @@ -1952,7 +1952,7 @@ subroutine opsinputs_fill_fillstring( & character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping integer(integer64), intent(in) :: StringLen -character(len=StringLen), pointer :: String1(:) +character(len=StringLen), pointer, intent(inout) :: String1(:) type(c_ptr), value, intent(in) :: ObsSpace character(len=*), intent(in) :: JediVarName character(len=*), intent(in) :: JediVarGroup @@ -2361,7 +2361,7 @@ subroutine opsinputs_fill_fillcoord2d_norecords( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -type(coord_type), pointer :: Coord2(:,:) +type(coord_type), pointer, intent(inout) :: Coord2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) character(len=*), intent(in) :: JediVarName @@ -2430,7 +2430,7 @@ subroutine opsinputs_fill_fillcoord2d_records( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping -type(coord_type), pointer :: Coord2(:,:) +type(coord_type), pointer, intent(inout) :: Coord2(:,:) type(c_ptr), value, intent(in) :: ObsSpace character(len=*), intent(in) :: JediVarName character(len=*), intent(in) :: JediVarGroup @@ -2502,7 +2502,7 @@ subroutine opsinputs_fill_fillcoord2d( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName type(opsinputs_jeditoopslayoutmapping), intent(in) :: JediToOpsLayoutMapping -type(coord_type), pointer :: Coord2(:,:) +type(coord_type), pointer, intent(inout) :: Coord2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) character(len=*), intent(in) :: JediVarName diff --git a/src/opsinputs/opsinputs_varobswriter_mod.F90 b/src/opsinputs/opsinputs_varobswriter_mod.F90 index 62aede88..4d0dae9c 100644 --- a/src/opsinputs/opsinputs_varobswriter_mod.F90 +++ b/src/opsinputs/opsinputs_varobswriter_mod.F90 @@ -715,8 +715,8 @@ subroutine opsinputs_varobswriter_populateobservations( & integer :: iVarField integer :: iobs character(len=200) :: varname -logical :: FillChanNum = .false. -logical :: FillNumChans = .false. +logical, save :: FillChanNum = .false. +logical, save :: FillNumChans = .false. ! Body: @@ -1518,7 +1518,7 @@ subroutine opsinputs_varobswriter_fillpredictors( & type(ElementHeader_Type), intent(inout) :: Hdr character(len=*), intent(in) :: OpsVarName integer(integer64), intent(in) :: NumObs -real(real64), pointer :: Real2(:,:) +real(real64), pointer, intent(inout) :: Real2(:,:) type(c_ptr), value, intent(in) :: ObsSpace integer(c_int), intent(in) :: Channels(:) character(len=*), intent(in) :: JediVarName