├── addrealkind ├── FortranTools │ ├── install.rb │ ├── tmp │ │ ├── README │ │ ├── new │ │ │ ├── tst0.F90 │ │ │ └── tst1.F90 │ │ └── orig │ │ │ ├── tst0.F90 │ │ │ ├── tst1.F90 │ │ │ └── tst1_repl.F90 │ ├── BACKUP │ │ ├── 05_04_12 │ │ │ ├── ts_all.rb │ │ │ ├── tstMaskedString.rb │ │ │ └── tc_maskedString.rb │ │ ├── 05_04_13 │ │ │ ├── ts_all.rb │ │ │ └── tstMaskedString.rb │ │ ├── 05_04_14 │ │ │ ├── ts_all.rb │ │ │ └── tstMaskedString.rb │ │ ├── 05_04_26 │ │ │ ├── ts_all.rb │ │ │ ├── tstMaskedString.rb │ │ │ └── README │ │ ├── 05_04_29 │ │ │ ├── ts_all.rb │ │ │ ├── tstMaskedString.rb │ │ │ └── README │ │ ├── 05_05_02 │ │ │ ├── ts_all.rb │ │ │ └── tstMaskedString.rb │ │ ├── 05_04_29_WORK │ │ │ ├── ts_all.rb │ │ │ └── tstMaskedString.rb │ │ ├── 05_04_29_WORK2 │ │ │ ├── ts_all.rb │ │ │ └── tstMaskedString.rb │ │ ├── 05_05_03 │ │ │ └── ts_all.rb │ │ ├── 05_05_04 │ │ │ ├── ts_all.rb │ │ │ └── addRealKind.rb │ │ ├── 05_05_05 │ │ │ ├── ts_all.rb │ │ │ └── test_addRealKind.csh │ │ ├── 05_05_06 │ │ │ └── ts_all.rb │ │ ├── 05_05_09 │ │ │ └── ts_all.rb │ │ ├── 05_05_12 │ │ │ └── ts_all.rb │ │ ├── 05_05_13 │ │ │ └── ts_all.rb │ │ ├── 05_05_16 │ │ │ ├── ts_all.rb │ │ │ └── install.rb │ │ ├── 05_05_17 │ │ │ ├── ts_all.rb │ │ │ ├── ESMF_PUBLIC_operators.out │ │ │ ├── findsymbol_app │ │ │ ├── addrealkind_app │ │ │ └── install.rb │ │ ├── 05_05_18 │ │ │ ├── ts_all.rb │ │ │ ├── tc_findsymbol_app.rb │ │ │ └── install.rb │ │ ├── 05_05_03_start │ │ │ ├── ts_all.rb │ │ │ ├── tc_argumentParser.rb │ │ │ └── argumentParser.rb │ │ ├── 05_05_16_START │ │ │ ├── ts_all.rb │ │ │ └── install.rb │ │ ├── 05_05_20 │ │ │ ├── ts_all.rb │ │ │ └── install.rb │ │ └── 05_04_20 │ │ │ └── tstMaskedString.rb │ ├── ts_all.rb │ ├── continuation_test │ │ ├── tst0_statements.F90 │ │ ├── tst0_statements_OK.F90 │ │ ├── build.sh │ │ ├── makefile │ │ ├── tst0.F90 │ │ ├── tst0_fp.F90 │ │ ├── tst0_fp_OK.F90 │ │ ├── tst0_unmask.F90 │ │ ├── tst0_unmask_OK.F90 │ │ ├── tst0_fpuse.F90 │ │ ├── tst0_fpuse_OK.F90 │ │ ├── c_statements.f90 │ │ ├── c_statements_OK.f90 │ │ ├── c.f90 │ │ ├── c_fp.f90 │ │ ├── c_fp_OK.f90 │ │ ├── c_fpuse.f90 │ │ ├── c_fpuse_OK.f90 │ │ ├── c_unmask.f90 │ │ ├── c_unmask_OK.f90 │ │ ├── tst_fp_OK.F90 │ │ ├── tst1_statements.F90 │ │ ├── tst1_statements_OK.F90 │ │ ├── tst_fp_statements.F90 │ │ ├── tst_fp_statements_OK.F90 │ │ ├── dadadjnor8_statements.F90 │ │ ├── dadadjnor8_statements_OK.F90 │ │ ├── dadadj_statements.F90 │ │ ├── dadadj_statements_OK.F90 │ │ ├── tst1.F90 │ │ ├── tst1_repl.F90 │ │ ├── tst1_repl_OK.F90 │ │ ├── tst1_unmask.F90 │ │ └── tst1_unmask_OK.F90 │ ├── TESTDIR_addRealKind │ │ ├── tst0_fp.F90 │ │ ├── tst0_fpuse.F90 │ │ ├── c_fp.f90 │ │ ├── c_fpuse.f90 │ │ ├── tst1_fp.F90 │ │ └── tst1_repl.F90 │ ├── test_addRealKind.csh │ ├── WRFV2_20050512_1410_WORK.ESMF_USE.out │ ├── findsymbol_app │ ├── addrealkind_app │ ├── tmp.out │ ├── handTests │ │ └── tstMaskedString.rb │ ├── findsymbol_test │ │ ├── FESMF.f │ │ ├── FESMF_Base_C.f │ │ ├── FESMF_Fraction.f │ │ ├── FESMF_BaseTime.f │ │ └── FESMF_TimeType.f │ ├── findsymbol_out │ │ ├── findsymbol_source │ │ │ └── FESMF.f │ │ └── findsymbol_source_OK │ │ │ └── FESMF.f │ └── \ ├── installer │ └── test.install │ │ ├── install.rb │ │ ├── clean │ │ ├── ts_tmp.rb │ │ ├── tmpA_app │ │ └── tmpB_app ├── ChangeLog ├── findsymbol └── addrealkind ├── README.md ├── cam_snapshot_src_mods ├── zhang_mcfarlane │ └── README └── rrtmgp │ └── README ├── old_suite_files └── README.txt └── namelist_conversion_tool └── README /addrealkind/FortranTools/install.rb: -------------------------------------------------------------------------------- 1 | ../installer/install.rb -------------------------------------------------------------------------------- /addrealkind/installer/test.install/install.rb: -------------------------------------------------------------------------------- 1 | ../install.rb -------------------------------------------------------------------------------- /addrealkind/installer/test.install/clean: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | 3 | \rm -f app/tmp* 4 | \rm -fR lib/* 5 | 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CAM-SIMA_backups 2 | A repo that stores backups for certain (potentially temporary) source codes. 3 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/README: -------------------------------------------------------------------------------- 1 | 2 | >> \rm -fR new 3 | >> cp -rp orig new 4 | >> addrealkind -d new -r r8 5 | >> difftree -v 3 orig/ new/ 6 | 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_12/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_13/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_14/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_26/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_02/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29_WORK/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29_WORK2/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_fortranLine' 5 | require 'tc_maskedString' 6 | require 'tc_fortranStatements' 7 | -------------------------------------------------------------------------------- /cam_snapshot_src_mods/zhang_mcfarlane/README: -------------------------------------------------------------------------------- 1 | This was based off of cam6_4_047 2 | 3 | Needed to comment out the custom modifications of water species in physics_update as they are not applied in CAM-SIMA 4 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_03/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_04/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_05/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_06/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_09/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_12/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_13/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_16/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_17/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_18/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_03_start/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_16_START/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | require 'tc_findsymbol_app' 9 | 10 | -------------------------------------------------------------------------------- /addrealkind/installer/test.install/ts_tmp.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | require 'tc_findsymbol_app' 9 | 10 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_20/ts_all.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'tc_maskedString' 5 | require 'tc_argumentParser' 6 | require 'tc_fortranLine' 7 | require 'tc_fortranStatements' 8 | require 'tc_findsymbol_app' 9 | 10 | -------------------------------------------------------------------------------- /cam_snapshot_src_mods/rrtmgp/README: -------------------------------------------------------------------------------- 1 | The mods in this directory are based on cam6_4_119 and used to generate ne3pg3 snapshots for RRTMGP. 2 | Also note that due to the fact that RRTMGP is run in before_coupler in CAM on the first timestep, any 3 | snapshot used as comparison should begin at timestep 2. 4 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_17/ESMF_PUBLIC_operators.out: -------------------------------------------------------------------------------- 1 | OPERATOR(*) 2 | OPERATOR(+) 3 | OPERATOR(-) 4 | OPERATOR(.DIV.) 5 | OPERATOR(.EQ.), OPERATOR(.NE.) 6 | OPERATOR(.EQ.), OPERATOR(.NE.), ASSIGNMENT(=) 7 | OPERATOR(.EQ.),OPERATOR(.GT.) 8 | OPERATOR(/) 9 | OPERATOR(/=) 10 | OPERATOR(<) 11 | OPERATOR(<=) 12 | OPERATOR(==) 13 | OPERATOR(==), OPERATOR(/=) 14 | OPERATOR(>) 15 | OPERATOR(>=) 16 | -------------------------------------------------------------------------------- /old_suite_files/README.txt: -------------------------------------------------------------------------------- 1 | These files were the first attempt at writing Suite Definition Files (SDFS) for CAM. However, 2 | while helpful as a reference, they are generally out-of-date enough that they are likely not beneficial 3 | for CAM-SIMA or any other CCPP-enabled host model as actual SDF files. Thus once a "real" SDF file 4 | exists in atmospheric_physics for that version, then the corresponding SDF here should probably be deleted. 5 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_statements.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , q ) 2 | 3 | implicit none 4 | integer, intent(in) :: lchnk 5 | integer, intent(in) :: ncol 6 | real(r8), intent(inout) :: q(pcols,pver) 7 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 8 | end subroutine tst0 9 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_statements_OK.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , q ) 2 | 3 | implicit none 4 | integer, intent(in) :: lchnk 5 | integer, intent(in) :: ncol 6 | real(r8), intent(inout) :: q(pcols,pver) 7 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 8 | end subroutine tst0 9 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | echo "pgf90 -o c.exe c.f90" 3 | pgf90 -o c.exe c.f90 4 | 5 | echo "pgf90 -o c_statements.exe c_statements.f90" 6 | pgf90 -o c_statements.exe c_statements.f90 7 | 8 | echo "pgf90 -o tst_fp.exe tst_fp.F90" 9 | pgf90 -o tst_fp.exe tst_fp.F90 10 | 11 | echo "pgf90 -o tst_fp_fp.exe tst_fp_fp.F90" 12 | pgf90 -o tst_fp_fp.exe tst_fp_fp.F90 13 | 14 | echo "pgf90 -c tst1_fpuse.F90" 15 | pgf90 -c tst1_fpuse.F90 16 | 17 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/makefile: -------------------------------------------------------------------------------- 1 | 2 | COMP=pgf90 3 | 4 | all: c.exe c_statements.exe tst_fp.exe tst_fp_fp.exe tst1_fpuse.o 5 | 6 | c.exe: c.f90 7 | $(COMP) -o c.exe c.f90 8 | 9 | c_statements.exe: c_statements.f90 10 | $(COMP) -o c_statements.exe c_statements.f90 11 | 12 | tst_fp.exe: tst_fp.F90 13 | $(COMP) -o tst_fp.exe tst_fp.F90 14 | 15 | tst_fp_fp.exe: tst_fp_fp.F90 16 | $(COMP) -o tst_fp_fp.exe tst_fp_fp.F90 17 | 18 | tst1_fpuse.o: tst1_fpuse.F90 19 | $(COMP) -c tst1_fpuse.F90 20 | 21 | clean: 22 | \rm -f *.exe *.o *.mod 23 | 24 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/new/tst0.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/orig/tst0.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/tst0_fp.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_fp.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_fp_OK.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | !----------------------------------------------------------------------- 4 | implicit none 5 | integer, intent(in) :: lchnk ! chunk identifier 6 | integer, intent(in) :: ncol ! number of atmospheric columns 7 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 8 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 9 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_unmask.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , @ 2 | q ) 3 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 4 | implicit none 5 | integer, intent(in) :: lchnk @@@@@@@@@@@@@@@@@@ 6 | integer, intent(in) :: ncol @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 7 | real(r8), intent(inout) :: q(pcols,pver) @@@@@@@@@@@@@@@@@@@ 8 | 810 format(//,@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@,E9.4, @ 9 | @@@@@@/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@, @ 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_unmask_OK.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , @ 2 | q ) 3 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 4 | implicit none 5 | integer, intent(in) :: lchnk @@@@@@@@@@@@@@@@@@ 6 | integer, intent(in) :: ncol @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 7 | real(r8), intent(inout) :: q(pcols,pver) @@@@@@@@@@@@@@@@@@@ 8 | 810 format(//,@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@,E9.4, @ 9 | @@@@@@/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@, @ 10 | 2i5) 11 | end subroutine tst0 12 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_fpuse.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | USE module_fp, only: r8 => wrf_kind_r4 4 | !----------------------------------------------------------------------- 5 | implicit none 6 | integer, intent(in) :: lchnk ! chunk identifier 7 | integer, intent(in) :: ncol ! number of atmospheric columns 8 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 9 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 10 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 11 | 2i5) 12 | end subroutine tst0 13 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/tst0_fpuse.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | USE module_fp, only: r8 => wrf_kind_r4 4 | !----------------------------------------------------------------------- 5 | implicit none 6 | integer, intent(in) :: lchnk ! chunk identifier 7 | integer, intent(in) :: ncol ! number of atmospheric columns 8 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 9 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 10 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 11 | 2i5) 12 | end subroutine tst0 13 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst0_fpuse_OK.F90: -------------------------------------------------------------------------------- 1 | subroutine tst0 (lchnk ,ncol , & 2 | q ) 3 | USE module_fp, only: r8 => wrf_kind_r4 4 | !----------------------------------------------------------------------- 5 | implicit none 6 | integer, intent(in) :: lchnk ! chunk identifier 7 | integer, intent(in) :: ncol ! number of atmospheric columns 8 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 9 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 10 | ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 11 | 2i5) 12 | end subroutine tst0 13 | -------------------------------------------------------------------------------- /addrealkind/ChangeLog: -------------------------------------------------------------------------------- 1 | ============================================================== 2 | Tag name: addrealkind_111011a 3 | Originator(s): fischer 4 | Date: October 10, 2011 5 | One-line Summary: Changes to only report missing r8, and return 6 | and error code 7 | 8 | M FortranTools/addRealKind.rb 9 | M FortranTools/fortranStatements.rb 10 | Changes to code so that only the locations of missing r8 are 11 | returned, and no files are changed 12 | 13 | M FortranTools/addrealkind_app 14 | return error code 15 | 16 | ============================================================== 17 | Tag name: addrealkind_111011 18 | Originator(s): fischer 19 | Date: October 10, 2011 20 | One-line Summary: Original code import 21 | ============================================================== 22 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_05/test_addRealKind.csh: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | # 3 | # Set up and run simple test of addRealKind.rb 4 | # 5 | 6 | set origdir = continuation_test 7 | set testdir = TESTDIR_addRealKind 8 | \rm -fR ${testdir} 9 | mkdir ${testdir} 10 | \cp ${origdir}/*.[fF]* ${testdir} 11 | \rm -f ${testdir}/*unmask* 12 | \rm -f ${testdir}/*statement* 13 | \rm -f ${testdir}/*OK* 14 | \rm -f ${testdir}/*_fp.* 15 | \cp continuation_test/tst_fp.F90 ${testdir} 16 | 17 | addRealKind.rb -d ${testdir} 18 | 19 | mv ${testdir}/c.f90 ${testdir}/c_fp.f90 20 | mv ${testdir}/dadadj.F90 ${testdir}/dadadj_fp.F90 21 | mv ${testdir}/dadadjnor8.F90 ${testdir}/dadadjnor8_fp.F90 22 | mv ${testdir}/tst0.F90 ${testdir}/tst0_fp.F90 23 | mv ${testdir}/tst1.F90 ${testdir}/tst1_fp.F90 24 | mv ${testdir}/tst_fp.F90 ${testdir}/tst_fp_fp.F90 25 | 26 | diffcvs ${origdir} ${testdir} 27 | 28 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/test_addRealKind.csh: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | # 3 | # Set up and run simple test of addRealKind.rb 4 | # 5 | 6 | set origdir = continuation_test 7 | set testdir = TESTDIR_addRealKind 8 | \rm -fR ${testdir} 9 | mkdir ${testdir} 10 | \cp ${origdir}/*.[fF]* ${testdir} 11 | \rm -f ${testdir}/*unmask* 12 | \rm -f ${testdir}/*statement* 13 | \rm -f ${testdir}/*OK* 14 | \rm -f ${testdir}/*_fp.* 15 | \cp continuation_test/tst_fp.F90 ${testdir} 16 | 17 | #addRealKind.rb -d ${testdir} -v 2 18 | addRealKind.rb -d ${testdir} 19 | 20 | mv ${testdir}/c.f90 ${testdir}/c_fp.f90 21 | mv ${testdir}/dadadj.F90 ${testdir}/dadadj_fp.F90 22 | mv ${testdir}/dadadjnor8.F90 ${testdir}/dadadjnor8_fp.F90 23 | mv ${testdir}/tst0.F90 ${testdir}/tst0_fp.F90 24 | mv ${testdir}/tst1.F90 ${testdir}/tst1_fp.F90 25 | mv ${testdir}/tst_fp.F90 ${testdir}/tst_fp_fp.F90 26 | 27 | diffcvs ${origdir} ${testdir} 28 | 29 | -------------------------------------------------------------------------------- /namelist_conversion_tool/README: -------------------------------------------------------------------------------- 1 | The script newCAM_namelist.py was written by Steve Goldhaber. It requires namelist_defaults_cam.xml and namelist_definition_old.xm. to exist in the directory where this python script will be run. 2 | 3 | To run it: "python newCAM_namelist.py" 4 | 5 | Current limitations: 6 | 7 | - The SILHS namelist has "%" in some of their namelist names, which is a prohibited variable within this tool. In the 8 | exomple namelist_defaults_cam.xml file included here, these variables have been commented out. 9 | 10 | - All namelist names which do not reside in namelist_defaults_cam.xml file cause an error and are listed when this tool is run. 11 | They need to be commented out, removed or a definition needs to be added. The thought is once this is done, the script will do the 12 | conversion. The "aircraft_co2_file" section has been disabled to prove that removing this variable gets rid of the error message. 13 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/WRFV2_20050512_1410_WORK.ESMF_USE.out: -------------------------------------------------------------------------------- 1 | ESMF_ALARM 2 | ESMF_ALARMCREATE 3 | ESMF_ALARMENABLE 4 | ESMF_ALARMISRINGING 5 | ESMF_ALARMRINGEROFF 6 | ESMF_ALARMRINGERON 7 | ESMF_ALARMSET 8 | ESMF_CLOCK 9 | ESMF_CLOCKADDALARM 10 | ESMF_CLOCKADVANCE 11 | ESMF_CLOCKCREATE 12 | ESMF_CLOCKGET 13 | ESMF_CLOCKGETALARMLIST 14 | ESMF_CLOCKISSTOPTIME 15 | ESMF_CLOCKPRINT 16 | ESMF_CLOCKSET 17 | ESMF_CLOCKSETOLD 18 | ESMF_CLOCKSTOPTIMEDISABLE 19 | ESMF_CLOCKVALIDATE 20 | ESMF_FINALIZE 21 | ESMF_GRIDCOMP 22 | ESMF_GRIDCOMPCREATE 23 | ESMF_GRIDCOMPDESTROY 24 | ESMF_GRIDCOMPFINALIZE 25 | ESMF_GRIDCOMPINITIALIZE 26 | ESMF_GRIDCOMPRUN 27 | ESMF_GRIDCOMPSETENTRYPOINT 28 | ESMF_GRIDCOMPSETSERVICES 29 | ESMF_INITIALIZE 30 | ESMF_LOGWRITE 31 | ESMF_MOD 32 | ESMF_SINGLEPHASE 33 | ESMF_STATE 34 | ESMF_SUCCESS 35 | ESMF_TIME 36 | ESMF_TIMEGET 37 | ESMF_TIMEINTERVAL 38 | ESMF_TIMEINTERVALSET 39 | ESMF_TIMESET 40 | ESMF_VM 41 | MODULE_WRF_ESMF_SUPER 42 | WRF_ESMF_LOGERR 43 | WRF_ESMF_MOD 44 | -------------------------------------------------------------------------------- /addrealkind/installer/test.install/tmpA_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that finds all symbols that match a specified 10 | # String in all Fortran source files beneath a specified directory. 11 | # 12 | # Type "ruby findsymbol -h" for command-line options. 13 | # 14 | # 15 | # Assumptions: 16 | # Source code is in Fortran90/95 free form. 17 | # Source code compiles. 18 | # 19 | # 20 | # History: 21 | # 22 | # Version 0.1 - Initial alpha-test version. 23 | # 24 | #============================================================================== 25 | 26 | $: << "LIB___DIR" 27 | require 'findSymbol' 28 | 29 | if ($:.last =~ /lib___dir/i) then 30 | raise "ERROR: please run script \"install.rb\" first to install this application" 31 | end 32 | 33 | app = FindSymbol.new 34 | 35 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that finds all symbols that match a specified 10 | # String in all Fortran source files beneath a specified directory. 11 | # 12 | # Type "ruby findsymbol -h" for command-line options. 13 | # 14 | # 15 | # Assumptions: 16 | # Source code is in Fortran90/95 free form. 17 | # Source code compiles. 18 | # 19 | # 20 | # History: 21 | # 22 | # Version 0.1 - Initial alpha-test version. 23 | # 24 | #============================================================================== 25 | 26 | $: << "LIB___DIR" 27 | 28 | if ($:.last =~ /lib___dir/i) then 29 | raise "ERROR: please run script \"install.rb\" first to install this application" 30 | end 31 | 32 | require 'findSymbol' 33 | 34 | app = FindSymbol.new 35 | 36 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_17/findsymbol_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that finds all symbols that match a specified 10 | # String in all Fortran source files beneath a specified directory. 11 | # 12 | # Type "ruby findsymbol -h" for command-line options. 13 | # 14 | # 15 | # Assumptions: 16 | # Source code is in Fortran90/95 free form. 17 | # Source code compiles. 18 | # 19 | # 20 | # History: 21 | # 22 | # Version 0.1 - Initial alpha-test version. 23 | # 24 | #============================================================================== 25 | 26 | $: << "LIB___DIR" 27 | require 'findSymbol' 28 | 29 | if ($:.last =~ /lib___dir/i) then 30 | raise "ERROR: please run script \"install.rb\" first to install this application" 31 | end 32 | 33 | app = FindSymbol.new 34 | 35 | -------------------------------------------------------------------------------- /addrealkind/findsymbol: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that finds all symbols that match a specified 10 | # String in all Fortran source files beneath a specified directory. 11 | # 12 | # Type "ruby findsymbol -h" for command-line options. 13 | # 14 | # 15 | # Assumptions: 16 | # Source code is in Fortran90/95 free form. 17 | # Source code compiles. 18 | # 19 | # 20 | # History: 21 | # 22 | # Version 0.1 - Initial alpha-test version. 23 | # 24 | #============================================================================== 25 | 26 | $: << "/fs/cgd/csm/tools/addrealkind/FortranTools" 27 | 28 | if ($:.last =~ /lib___dir/i) then 29 | raise "ERROR: please run script \"install.rb\" first to install this application" 30 | end 31 | 32 | require 'findSymbol' 33 | 34 | app = FindSymbol.new 35 | 36 | -------------------------------------------------------------------------------- /addrealkind/installer/test.install/tmpB_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that adds a Fortran "kind" parameter to 10 | # every REAL and COMPLEX declaration, literal constant, and cast (via 11 | # intrinsic functions "REAL" and "CMPLX") where a kind parameter does 12 | # not already exist. Source files are modified in-place. 13 | # 14 | # Type "ruby addrealkind -h" for command-line options. 15 | # 16 | # 17 | # Assumptions: 18 | # Source code is in Fortran90/95 free form. 19 | # Source code compiles. 20 | # 21 | # 22 | # History: 23 | # 24 | # Version 0.1 - Initial alpha-test version. Supported by a large unit-test 25 | # suite. 26 | # 27 | #============================================================================== 28 | 29 | $: << "LIB___DIR" 30 | require 'addRealKind' 31 | 32 | if ($:.last =~ /lib___dir/i) then 33 | raise "ERROR: please run script \"install.rb\" first to install this application" 34 | end 35 | 36 | app = AddRealKind.new 37 | 38 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_17/addrealkind_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that adds a Fortran "kind" parameter to 10 | # every REAL and COMPLEX declaration, literal constant, and cast (via 11 | # intrinsic functions "REAL" and "CMPLX") where a kind parameter does 12 | # not already exist. Source files are modified in-place. 13 | # 14 | # Type "ruby addrealkind -h" for command-line options. 15 | # 16 | # 17 | # Assumptions: 18 | # Source code is in Fortran90/95 free form. 19 | # Source code compiles. 20 | # 21 | # 22 | # History: 23 | # 24 | # Version 0.1 - Initial alpha-test version. Supported by a large unit-test 25 | # suite. 26 | # 27 | #============================================================================== 28 | 29 | $: << "LIB___DIR" 30 | require 'addRealKind' 31 | 32 | if ($:.last =~ /lib___dir/i) then 33 | raise "ERROR: please run script \"install.rb\" first to install this application" 34 | end 35 | 36 | app = AddRealKind.new 37 | 38 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/addrealkind_app: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that adds a Fortran "kind" parameter to 10 | # every REAL and COMPLEX declaration, literal constant, and cast (via 11 | # intrinsic functions "REAL" and "CMPLX") where a kind parameter does 12 | # not already exist. Source files are modified in-place. 13 | # 14 | # Type "ruby addrealkind -h" for command-line options. 15 | # 16 | # 17 | # Assumptions: 18 | # Source code is in Fortran90/95 free form. 19 | # Source code compiles. 20 | # 21 | # 22 | # History: 23 | # 24 | # Version 0.1 - Initial alpha-test version. Supported by a large unit-test 25 | # suite. 26 | # 27 | #============================================================================== 28 | 29 | $: << "LIB___DIR" 30 | 31 | if ($:.last =~ /lib___dir/i) then 32 | raise "ERROR: please run script \"install.rb\" first to install this application" 33 | end 34 | 35 | require 'addRealKind' 36 | 37 | app = AddRealKind.new 38 | 39 | exit $found_missing 40 | 41 | -------------------------------------------------------------------------------- /addrealkind/addrealkind: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Organization: NCAR MMM 6 | # 7 | # Description: 8 | # 9 | # This is an application that adds a Fortran "kind" parameter to 10 | # every REAL and COMPLEX declaration, literal constant, and cast (via 11 | # intrinsic functions "REAL" and "CMPLX") where a kind parameter does 12 | # not already exist. Source files are modified in-place. 13 | # 14 | # Type "ruby addrealkind -h" for command-line options. 15 | # 16 | # 17 | # Assumptions: 18 | # Source code is in Fortran90/95 free form. 19 | # Source code compiles. 20 | # 21 | # 22 | # History: 23 | # 24 | # Version 0.1 - Initial alpha-test version. Supported by a large unit-test 25 | # suite. 26 | # 27 | #============================================================================== 28 | 29 | $: << "/fs/cgd/csm/tools/addrealkind/FortranTools" 30 | 31 | if ($:.last =~ /lib___dir/i) then 32 | raise "ERROR: please run script \"install.rb\" first to install this application" 33 | end 34 | 35 | require 'addRealKind' 36 | 37 | app = AddRealKind.new 38 | 39 | exit $found_missing 40 | 41 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp.out: -------------------------------------------------------------------------------- 1 | ./argumentParser.rb:123:in `find_args': ERROR: ran past end of string trying to find first matching ")" (ArgumentParserException) 2 | from ./argumentParser.rb:101:in `initialize' 3 | from ./fortranStatements.rb:367:in `new' 4 | from ./fortranStatements.rb:367:in `findSymbols' 5 | from ./fortranStatements.rb:777:in `findSymbols' 6 | from ./fortranStatements.rb:772:in `each' 7 | from ./fortranStatements.rb:772:in `findSymbols' 8 | from ./findSymbol.rb:266:in `search_source_files' 9 | from ./findSymbol.rb:241:in `find' 10 | from /usr/lib/ruby/1.8/find.rb:38:in `catch' 11 | from /usr/lib/ruby/1.8/find.rb:38:in `find' 12 | from ./findSymbol.rb:241:in `search_source_files' 13 | from ./findSymbol.rb:70:in `initialize' 14 | from /users/hender/bin/findsymbol:33:in `new' 15 | from /users/hender/bin/findsymbol:33 16 | 17 | findsymbol: Searching for all symbols matching "WRF_ESMF_MOD" in all Fortran source files in directory "tmp". 18 | Symbol WRF_ESMF_MOD will be replaced by module_comp modifying Fortran source files in place. 19 | 20 | findsymbol: Searching Fortran source file "tmp/tmp.F"... 21 | DEBUG: tmp_str = <> 22 | DEBUG: @in_str = <> 23 | DEBUG: tmp_str = < -2 or ime (',ime,') > ',NMM_MAX_DIM, '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.')>> 24 | DEBUG: @in_str = < -2 or ime (',ime,') > ',NMM_MAX_DIM, '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.')>> 25 | ERROR searching file tmp/tmp.F at line 2 26 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_statements.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + y 11 | print *, 'zzz = ',zzz 12 | zzz = x * y 13 | print *, 'zzz = ',zzz 14 | zzz = x -y 15 | print *, 'zzz = ',zzz 16 | 17 | lawyers = 'Jones & Clay & Davis' 18 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 19 | 20 | lawyers = 'Jones! &! Clay! &! Davis!' 21 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 22 | 23 | 24 | 25 | 26 | 27 | 28 | lawyers = 'Jones & Clay & Davis' 29 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 30 | 31 | lawyers = 'Jones & Clay & Davis' 32 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & ''Clay'' & Davis' 35 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 36 | 37 | lawyers = 'Jones & ""Clay"" & Davis' 38 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 39 | 40 | lawyers = "Jones & ""Clay"" & Davis" 41 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 42 | 43 | lawyers = "Jones & ''Clay'' & Davis" 44 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 45 | 46 | lawyers = 'Jones & Clay & Davis' 47 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 48 | 49 | lawyers = 'Jones & Clay & Davis' 50 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 51 | 52 | lawyers = 'Jones & Clay & Davis' 53 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 54 | 55 | lawyers = 'Jones & Clay & Davis' 56 | print *,'LAWYERS_13 = <<',trim(lawyers),">>" 57 | 58 | 59 | 60 | 61 | 62 | lawyers = 'Jones & ''Clay'' & Davis' 63 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & ''Clay'' & Davis' 66 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | end program contd 84 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_statements_OK.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + y 11 | print *, 'zzz = ',zzz 12 | zzz = x * y 13 | print *, 'zzz = ',zzz 14 | zzz = x -y 15 | print *, 'zzz = ',zzz 16 | 17 | lawyers = 'Jones & Clay & Davis' 18 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 19 | 20 | lawyers = 'Jones! &! Clay! &! Davis!' 21 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 22 | 23 | 24 | 25 | 26 | 27 | 28 | lawyers = 'Jones & Clay & Davis' 29 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 30 | 31 | lawyers = 'Jones & Clay & Davis' 32 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & ''Clay'' & Davis' 35 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 36 | 37 | lawyers = 'Jones & ""Clay"" & Davis' 38 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 39 | 40 | lawyers = "Jones & ""Clay"" & Davis" 41 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 42 | 43 | lawyers = "Jones & ''Clay'' & Davis" 44 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 45 | 46 | lawyers = 'Jones & Clay & Davis' 47 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 48 | 49 | lawyers = 'Jones & Clay & Davis' 50 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 51 | 52 | lawyers = 'Jones & Clay & Davis' 53 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 54 | 55 | lawyers = 'Jones & Clay & Davis' 56 | print *,'LAWYERS_13 = <<',trim(lawyers),">>" 57 | 58 | 59 | 60 | 61 | 62 | lawyers = 'Jones & ''Clay'' & Davis' 63 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & ''Clay'' & Davis' 66 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | end program contd 84 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/handTests/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_12/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_13/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_14/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_20/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_26/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_02/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29_WORK/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29_WORK2/tstMaskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'maskedString' 4 | 5 | 6 | print "Testing <<0123456789>> with []\n" 7 | ms = MaskedString.new("0123456789", []) 8 | print "base STRING = <<#{ms}>>\n" 9 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 10 | print "base STRING = <<#{ms}>>\n" 11 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 12 | print "base STRING = <<#{ms}>>\n" 13 | print "\n" 14 | 15 | print "Testing <<0123456789>> with [ (0..9) ]\n" 16 | ms = MaskedString.new("0123456789", [ (0..9) ]) 17 | print "base STRING = <<#{ms}>>\n" 18 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 19 | print "base STRING = <<#{ms}>>\n" 20 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 21 | print "base STRING = <<#{ms}>>\n" 22 | print "\n" 23 | 24 | print "Testing <<0123456789>> with [ (1..3), (6..8) ]\n" 25 | ms = MaskedString.new("0123456789", [ (1..3), (6..8) ]) 26 | print "base STRING = <<#{ms}>>\n" 27 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 28 | print "base STRING = <<#{ms}>>\n" 29 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 30 | print "base STRING = <<#{ms}>>\n" 31 | print "\n" 32 | 33 | print "Testing <<0123456789>> with [ (1..3), (4..8) ]\n" 34 | ms = MaskedString.new("0123456789", [ (1..3), (4..8) ]) 35 | print "base STRING = <<#{ms}>>\n" 36 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 37 | print "base STRING = <<#{ms}>>\n" 38 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 39 | print "base STRING = <<#{ms}>>\n" 40 | print "\n" 41 | 42 | print "Testing <<0123456789>> with [ (1..1), (3..5) ]\n" 43 | ms = MaskedString.new("0123456789", [ (1..1), (3..5) ]) 44 | print "base STRING = <<#{ms}>>\n" 45 | print "MASKED STRING = <<#{ms.get_masked}>>\n" 46 | print "base STRING = <<#{ms}>>\n" 47 | print "UNMASKED STRING = <<#{ms.get_unmasked}>>\n" 48 | print "base STRING = <<#{ms}>>\n" 49 | print "\n" 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_test/FESMF.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF.F90,v 1.28 2004/12/28 07:19:24 theurich Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | 14 | 15 | module ESMF_Mod 16 | 17 | use ESMF_BaseTypesMod 18 | use ESMF_LogErrMod 19 | use ESMF_BaseMod 20 | use ESMF_IOSpecMod 21 | 22 | use ESMF_FractionMod 23 | use ESMF_BaseTimeMod 24 | use ESMF_CalendarMod 25 | use ESMF_TimeIntervalMod 26 | use ESMF_TimeMod 27 | ! use ESMF_AlarmMod 28 | ! use ESMF_ClockMod 29 | 30 | ! use ESMF_ArraySpecMod 31 | ! use ESMF_LocalArrayMod 32 | ! use ESMF_ArrayDataMapMod 33 | 34 | ! use ESMF_VMMod 35 | ! use ESMF_DELayoutMod 36 | 37 | ! use ESMF_ConfigMod 38 | ! use ESMF_PerfProf 39 | 40 | ! use ESMF_ArrayMod 41 | ! use ESMF_ArrayCreateMod 42 | ! use ESMF_ArrayGetMod 43 | 44 | ! use ESMF_DistGridMod 45 | ! use ESMF_PhysCoordMod 46 | ! use ESMF_PhysGridMod 47 | ! use ESMF_GridTypesMod 48 | ! use ESMF_LogRectGridMod 49 | ! use ESMF_GridMod 50 | 51 | ! use ESMF_XPacketMod 52 | ! use ESMF_CommTableMod 53 | ! use ESMF_RTableMod 54 | ! use ESMF_RouteMod 55 | ! use ESMF_RHandleMod 56 | 57 | ! use ESMF_FieldDataMapMod 58 | ! use ESMF_ArrayCommMod 59 | 60 | ! use ESMF_FieldMod 61 | ! use ESMF_FieldGetMod 62 | ! use ESMF_FieldSetMod 63 | ! use ESMF_FieldCreateMod 64 | ! use ESMF_BundleDataMapMod 65 | ! use ESMF_BundleMod 66 | ! use ESMF_BundleGetMod 67 | 68 | ! use ESMF_RegridTypesMod 69 | ! use ESMF_RegridMod 70 | 71 | ! use ESMF_FieldCommMod 72 | ! use ESMF_BundleCommMod 73 | 74 | ! use ESMF_XformMod 75 | ! use ESMF_StateTypesMod 76 | ! use ESMF_StateMod 77 | ! use ESMF_StateGetMod 78 | ! use ESMF_StateReconcileMod 79 | ! use ESMF_CompMod 80 | ! use ESMF_GridCompMod 81 | ! use ESMF_CplCompMod 82 | 83 | ! use ESMF_InitMod 84 | 85 | end module ESMF_Mod 86 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_18/tc_findsymbol_app.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'findSymbol' 5 | require 'find' 6 | 7 | 8 | class TC_FindSymbolApp < Test::Unit::TestCase 9 | 10 | def setup 11 | # install findsymbol application in @installdir 12 | @installdir = "install_test" 13 | @app = "#{@installdir}/findsymbol" 14 | raise "directory #{@installdir} does not exist" unless (FileTest.directory?(@installdir)) 15 | # clean up 16 | self.uninstall_app 17 | # install 18 | `install.rb -d @installdir` 19 | @sourcedir = "findsymbol_test" 20 | raise "directory #{@sourcedir} does not exist" unless (FileTest.directory?(@sourcedir)) 21 | @sourceoutdir = "findsymbol_out/findsymbol_source" 22 | raise "directory #{@sourceoutdir} does not exist" unless (FileTest.directory?(@sourceoutdir)) 23 | @sourceoutdir_OK = "findsymbol_out/findsymbol_source_OK" 24 | raise "directory #{@sourceoutdir_OK} does not exist" unless (FileTest.directory?(@sourceoutdir_OK)) 25 | @stdoutdir = "findsymbol_out/findsymbol_stdout" 26 | raise "directory #{@stdoutdir} does not exist" unless (FileTest.directory?(@stdoutdir)) 27 | @stdoutdir_OK = "findsymbol_out/findsymbol_stdout_OK" 28 | raise "directory #{@stdoutdir_OK} does not exist" unless (FileTest.directory?(@stdoutdir_OK)) 29 | end 30 | 31 | def test_install 32 | FileTest.executable?(@app) 33 | assert(FileTest.executable?(@app), "installation") 34 | end 35 | 36 | def test_find_public_op_gen 37 | 38 | $$$here... just run install.rb and put the output in ./install_test/ and execute the installation 39 | $$$here... directly!! 40 | 41 | `#{@app} -d #{@sourcedir} -S ESMF_ -p -O -g WRF_COMP_ -o ESMF_Mod -n module_comp > & ! #{@stdoutdir_OK}/module_comp.F` 42 | 43 | $$$here... add option to write output to a named file for testing ("-w ") 44 | $$$here... "good" output in findsymbol_test/module_comp.F_OK 45 | $$$here... once findsymbol understands USE, ESMF_Test should no longer appear in 46 | $$$here... findsymbol_test/module_comp.F_OK 47 | 48 | end 49 | 50 | def teardown 51 | self.uninstall_app 52 | end 53 | 54 | def uninstall_app 55 | Find.find(@installdir) do |f| 56 | unless (FileTest.directory?(f)) then 57 | File.delete(f) 58 | end 59 | end 60 | end 61 | 62 | end # class TC_FindSymbolApp 63 | 64 | 65 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_out/findsymbol_source/FESMF.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF.F90,v 1.28 2004/12/28 07:19:24 theurich Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | 14 | 15 | module WRF_COMP_Mod 16 | 17 | use WRF_COMP_BaseTypesMod 18 | use WRF_COMP_LogErrMod 19 | use WRF_COMP_BaseMod 20 | use WRF_COMP_IOSpecMod 21 | 22 | use WRF_COMP_FractionMod 23 | use WRF_COMP_BaseTimeMod 24 | use WRF_COMP_CalendarMod 25 | use WRF_COMP_TimeIntervalMod 26 | use WRF_COMP_TimeMod 27 | ! use ESMF_AlarmMod 28 | ! use ESMF_ClockMod 29 | 30 | ! use ESMF_ArraySpecMod 31 | ! use ESMF_LocalArrayMod 32 | ! use ESMF_ArrayDataMapMod 33 | 34 | ! use ESMF_VMMod 35 | ! use ESMF_DELayoutMod 36 | 37 | ! use ESMF_ConfigMod 38 | ! use ESMF_PerfProf 39 | 40 | ! use ESMF_ArrayMod 41 | ! use ESMF_ArrayCreateMod 42 | ! use ESMF_ArrayGetMod 43 | 44 | ! use ESMF_DistGridMod 45 | ! use ESMF_PhysCoordMod 46 | ! use ESMF_PhysGridMod 47 | ! use ESMF_GridTypesMod 48 | ! use ESMF_LogRectGridMod 49 | ! use ESMF_GridMod 50 | 51 | ! use ESMF_XPacketMod 52 | ! use ESMF_CommTableMod 53 | ! use ESMF_RTableMod 54 | ! use ESMF_RouteMod 55 | ! use ESMF_RHandleMod 56 | 57 | ! use ESMF_FieldDataMapMod 58 | ! use ESMF_ArrayCommMod 59 | 60 | ! use ESMF_FieldMod 61 | ! use ESMF_FieldGetMod 62 | ! use ESMF_FieldSetMod 63 | ! use ESMF_FieldCreateMod 64 | ! use ESMF_BundleDataMapMod 65 | ! use ESMF_BundleMod 66 | ! use ESMF_BundleGetMod 67 | 68 | ! use ESMF_RegridTypesMod 69 | ! use ESMF_RegridMod 70 | 71 | ! use ESMF_FieldCommMod 72 | ! use ESMF_BundleCommMod 73 | 74 | ! use ESMF_XformMod 75 | ! use ESMF_StateTypesMod 76 | ! use ESMF_StateMod 77 | ! use ESMF_StateGetMod 78 | ! use ESMF_StateReconcileMod 79 | ! use ESMF_CompMod 80 | ! use ESMF_GridCompMod 81 | ! use ESMF_CplCompMod 82 | 83 | ! use ESMF_InitMod 84 | 85 | end module WRF_COMP_Mod 86 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_out/findsymbol_source_OK/FESMF.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF.F90,v 1.28 2004/12/28 07:19:24 theurich Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | 14 | 15 | module WRF_COMP_Mod 16 | 17 | use WRF_COMP_BaseTypesMod 18 | use WRF_COMP_LogErrMod 19 | use WRF_COMP_BaseMod 20 | use WRF_COMP_IOSpecMod 21 | 22 | use WRF_COMP_FractionMod 23 | use WRF_COMP_BaseTimeMod 24 | use WRF_COMP_CalendarMod 25 | use WRF_COMP_TimeIntervalMod 26 | use WRF_COMP_TimeMod 27 | ! use ESMF_AlarmMod 28 | ! use ESMF_ClockMod 29 | 30 | ! use ESMF_ArraySpecMod 31 | ! use ESMF_LocalArrayMod 32 | ! use ESMF_ArrayDataMapMod 33 | 34 | ! use ESMF_VMMod 35 | ! use ESMF_DELayoutMod 36 | 37 | ! use ESMF_ConfigMod 38 | ! use ESMF_PerfProf 39 | 40 | ! use ESMF_ArrayMod 41 | ! use ESMF_ArrayCreateMod 42 | ! use ESMF_ArrayGetMod 43 | 44 | ! use ESMF_DistGridMod 45 | ! use ESMF_PhysCoordMod 46 | ! use ESMF_PhysGridMod 47 | ! use ESMF_GridTypesMod 48 | ! use ESMF_LogRectGridMod 49 | ! use ESMF_GridMod 50 | 51 | ! use ESMF_XPacketMod 52 | ! use ESMF_CommTableMod 53 | ! use ESMF_RTableMod 54 | ! use ESMF_RouteMod 55 | ! use ESMF_RHandleMod 56 | 57 | ! use ESMF_FieldDataMapMod 58 | ! use ESMF_ArrayCommMod 59 | 60 | ! use ESMF_FieldMod 61 | ! use ESMF_FieldGetMod 62 | ! use ESMF_FieldSetMod 63 | ! use ESMF_FieldCreateMod 64 | ! use ESMF_BundleDataMapMod 65 | ! use ESMF_BundleMod 66 | ! use ESMF_BundleGetMod 67 | 68 | ! use ESMF_RegridTypesMod 69 | ! use ESMF_RegridMod 70 | 71 | ! use ESMF_FieldCommMod 72 | ! use ESMF_BundleCommMod 73 | 74 | ! use ESMF_XformMod 75 | ! use ESMF_StateTypesMod 76 | ! use ESMF_StateMod 77 | ! use ESMF_StateGetMod 78 | ! use ESMF_StateReconcileMod 79 | ! use ESMF_CompMod 80 | ! use ESMF_GridCompMod 81 | ! use ESMF_CplCompMod 82 | 83 | ! use ESMF_InitMod 84 | 85 | end module WRF_COMP_Mod 86 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_26/README: -------------------------------------------------------------------------------- 1 | file README 2 | Tom Henderson 4/6/05 3 | 4 | THINGS TO DO TO GET AUTO-TRANSLATION OF REAL DECLARATIONS AND REAL LITERAL 5 | CONSTANTS TO USE "kind" 6 | 7 | X Add capability of doing "gsub" on a masked string 8 | X Need new "MaskedString" class? 9 | X How to express the mask most conventiently? 10 | X list of Range objects 11 | X Need unit tests 12 | X Add string masks to FortranLine 13 | X Add unit tests 14 | X Add masked gsub to FortranLine 15 | X Add unit tests 16 | - Add translations of real and complex declarations 17 | - Watch out for casts! 18 | - Add translations of [d*]d.[d*] and [d*].d[d*] where "d" is a digit [0-9]. 19 | - Add translations of odder things like 1.0d0 20 | - Add option to name kind "fp" (WRF) or "r8" (CCSM) or ... 21 | - Deal with "IF ( x.gt.1 )" and other "." cases 22 | - Create test suite as described below 23 | 24 | 25 | DISCUSSION 26 | 27 | At one point while at CGD, I suggested building a bit of automation to handle 28 | all of the contributed code that did not use real(r8), 1.0_r8, etc. Of 29 | course, we never got around to it (or to any of the much more substantive 30 | suggestions I made due to CCSM3.0 and IPCC ;-) ). However, I am still 31 | convinced that it would be fairly easy to construct a bit of Perl regexp 32 | scripting to automate translation of real declarations to real(r8) and 33 | translate real literal constants to use the "r8" kind ("1.0" -> "1.0_r8"). I 34 | think this translator script would be very easy to test. I'd use a simple sed 35 | script to rip all of the "r8" bits out of CCSM code, run the translator to put 36 | them all back, and diff vs. original. With one more simple test file 37 | containing all of the stranger variants of real literals we'd have a solid 38 | unit test suite. Then we could put the translator script in tools/ and add a 39 | bit to the Web document http://www.mmm.ucar.edu/wrf/users/docs/wrf-phy.html 40 | that describes how to use the tool. And we'd want to run the tool 41 | ourselves every so often to make sure we didn't accidentally forget to put the 42 | r8's in in new code. That step could be part of the pre-check-in process. 43 | 44 | Of course, we'd want to change "r8" to something else! Maybe "fp" 45 | (floating-point precision) or something else short. 46 | 47 | So, I think we can make it easy to use F90 "kind" for REAL and COMPLEX types. 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_29/README: -------------------------------------------------------------------------------- 1 | file README 2 | Tom Henderson 4/6/05 3 | 4 | THINGS TO DO TO GET AUTO-TRANSLATION OF REAL DECLARATIONS AND REAL LITERAL 5 | CONSTANTS TO USE "kind" 6 | 7 | - Add driver to run this on all *.[Ff] and *.[Ff]90 files beneath a 8 | specified directory. 9 | - Start testing with WRF, CAM, SMS, etc. 10 | X Add capability of doing "gsub" on a masked string 11 | X Need new "MaskedString" class? 12 | X How to express the mask most conventiently? 13 | X list of Range objects 14 | X Need unit tests 15 | X Add string masks to FortranLine 16 | X Add unit tests 17 | X Add masked gsub to FortranLine 18 | X Add unit tests 19 | X Add translations of real and complex declarations 20 | X Watch out for casts! 21 | X Add translations of [d*]d.[d*] and [d*].d[d*] where "d" is a digit [0-9]. 22 | X Add translations of odder things like 1.0d0, 3e4, a = b3e4zx 23 | X Add option to name kind "fp" (WRF) or "r8" (CCSM) or ... 24 | X Deal with "IF ( x.gt.1 )" and other "." cases 25 | X Create test suite as described below 26 | 27 | 28 | DISCUSSION 29 | 30 | At one point while at CGD, I suggested building a bit of automation to handle 31 | all of the contributed code that did not use real(r8), 1.0_r8, etc. Of 32 | course, we never got around to it (or to any of the much more substantive 33 | suggestions I made due to CCSM3.0 and IPCC ;-) ). However, I am still 34 | convinced that it would be fairly easy to construct a bit of Perl regexp 35 | scripting to automate translation of real declarations to real(r8) and 36 | translate real literal constants to use the "r8" kind ("1.0" -> "1.0_r8"). I 37 | think this translator script would be very easy to test. I'd use a simple sed 38 | script to rip all of the "r8" bits out of CCSM code, run the translator to put 39 | them all back, and diff vs. original. With one more simple test file 40 | containing all of the stranger variants of real literals we'd have a solid 41 | unit test suite. Then we could put the translator script in tools/ and add a 42 | bit to the Web document http://www.mmm.ucar.edu/wrf/users/docs/wrf-phy.html 43 | that describes how to use the tool. And we'd want to run the tool 44 | ourselves every so often to make sure we didn't accidentally forget to put the 45 | r8's in in new code. That step could be part of the pre-check-in process. 46 | 47 | Of course, we'd want to change "r8" to something else! Maybe "fp" 48 | (floating-point precision) or something else short. 49 | 50 | So, I think we can make it easy to use F90 "kind" for REAL and COMPLEX types. 51 | 52 | 53 | 54 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_03_start/tc_argumentParser.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'argumentParser' 5 | 6 | 7 | class TestArgumentParser 8 | 9 | attr_reader :errorMsg 10 | 11 | def initialize(in_str, num_args_OK, args_OK) 12 | @instr = in_str 13 | @numargsOK = num_args_OK 14 | @argsOK = args_OK 15 | @ap = nil 16 | end 17 | 18 | def num_args_correct? 19 | @ap = ArgumentParser.new(@instr) 20 | numargs = @ap.num_args 21 | @errorMsg = "" 22 | resultOK?(@numargsOK, numargs, "NUMBER OF ARGUMENTS") 23 | end 24 | 25 | def args_correct? 26 | @ap = ArgumentParser.new(@instr) 27 | args = @ap.get_args.join(":") 28 | #print "DEBUG: args = <<#{@ap.get_args.join(":")}>>\n" 29 | @errorMsg = "" 30 | resultOK?(@argsOK, args, "ARGUMENTS") 31 | end 32 | 33 | def resultOK?(expected, actual, errorHeader) 34 | ret = (expected == actual) 35 | @errorMsg = "NO ERROR\n" 36 | unless ret then 37 | @errorMsg = "ERROR IN #{errorHeader}:\n" 38 | @errorMsg << "EXPECTED: <#{expected}>\n" 39 | @errorMsg << "BUT GOT: <#{actual}>\n" 40 | end 41 | ret 42 | end 43 | 44 | end # class TestArgumentParser 45 | 46 | 47 | 48 | class TC_ArgumentParser < Test::Unit::TestCase 49 | 50 | def setup 51 | @argtests = [] 52 | @argtests << TestArgumentParser.new( 53 | "arg1", 1, 54 | "arg1" ) 55 | @argtests << TestArgumentParser.new( 56 | "arg1,arg2,arg3", 3, 57 | "arg1:arg2:arg3" ) 58 | @argtests << TestArgumentParser.new( 59 | "arg1,(arg2,arg3)", 2, 60 | "arg1:(arg2,arg3)" ) 61 | @argtests << TestArgumentParser.new( 62 | "(arg1,(arg2,arg3)),arg4", 2, 63 | "(arg1,(arg2,arg3)):arg4" ) 64 | @argtests << TestArgumentParser.new( 65 | "(a1,(a2,a3)),a4,(a5,(a6,a7),a8)", 3, 66 | "(a1,(a2,a3)):a4:(a5,(a6,a7),a8)" ) 67 | @argtests << TestArgumentParser.new( 68 | "(a1,(a2,a3)", nil, 69 | "" ) 70 | @argtests << TestArgumentParser.new( 71 | "", 0, "" ) 72 | #$$$here... add tests 73 | end 74 | 75 | def test_num_args 76 | @argtests.each do |argtest| 77 | assert(argtest.num_args_correct?, argtest.errorMsg) 78 | end 79 | end 80 | 81 | def test_args 82 | @argtests.each do |argtest| 83 | assert(argtest.args_correct?, argtest.errorMsg) 84 | end 85 | end 86 | 87 | def teardown 88 | end 89 | 90 | end # class TC_ArgumentParser 91 | 92 | 93 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/c_fp.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_fp.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/c_fpuse.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_fp_OK.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_fpuse.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_fpuse_OK.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + & 11 | y 12 | print *, 'zzz = ',zzz 13 | zz& 14 | &z = x * & 15 | y 16 | print *, 'zzz = ',zzz 17 | zzz = x -& 18 | y 19 | print *, 'zzz = ',zzz 20 | 21 | lawyers = 'Jones & Clay & & 22 | &Davis' 23 | print *,'LAWYERS_1 = <',trim(lawyers),'>' 24 | 25 | lawyers = 'Jones! &! Clay! &! & 26 | &Davis!' 27 | print *,'LAWYERS_2 = <',trim(lawyers),'>' 28 | 29 | ! suspicious... is this outside of the standard? 30 | ! lawyers = 'Jones! &! Clay! &! & ! a comment 31 | ! &Davis!' 32 | ! print *,'LAWYERS_3 = <',trim(lawyers),'>' 33 | 34 | lawyers = 'Jones & Clay & & 35 | 36 | &Davis' 37 | print *,'LAWYERS_4 = <',trim(lawyers),'>' 38 | 39 | lawyers = 'Jones & Clay & & 40 | &Davis& 41 | &' 42 | print *,'LAWYERS_5 = <',trim(lawyers),'>' 43 | 44 | lawyers = 'Jones & ''Clay'' & & 45 | &Davis' 46 | print *,'LAWYERS_6 = <',trim(lawyers),'>' 47 | 48 | lawyers = 'Jones & ""Clay"" & & 49 | &Davis' 50 | print *,'LAWYERS_7 = <',trim(lawyers),'>' 51 | 52 | lawyers = "Jones & ""Clay"" & & 53 | &Davis" 54 | print *,'LAWYERS_8 = <',trim(lawyers),'>' 55 | 56 | lawyers = "Jones & ''Clay'' & & 57 | &Davis" 58 | print *,'LAWYERS_9 = <',trim(lawyers),'>' 59 | 60 | lawyers = 'Jones & Clay & & 61 | & & 62 | &Davis' 63 | print *,'LAWYERS_10 = <',trim(lawyers),'>' 64 | 65 | lawyers = 'Jones & Clay & & 66 | && 67 | &Davis' 68 | print *,'LAWYERS_11 = <',trim(lawyers),'>' 69 | 70 | lawyers = & ! a comment 71 | 'Jones & Clay & Da& 72 | &vis' 73 | print *,'LAWYERS_12 = <',trim(lawyers),'>' 74 | 75 | lawyers = 'Jones & Clay & Davis' 76 | print *,'LAWYERS_13 = <<',trim(lawyers),">& 77 | &>" 78 | 79 | ! We don't know if we're in a character context until we process the 80 | ! next line (i.e. for processing leading space in the continuation line). 81 | ! Not a problem for finding comments though... 82 | ! Do all compilers like this? (pgf90 does!) 83 | lawyers = 'Jones & ''Clay'& ! a comment 84 | &' & Davis' ! another comment 85 | print *,'LAWYERS_14 = <',trim(lawyers),'>' 86 | 87 | lawyers = 'Jones & ''Clay'& 88 | ' & Davis' 89 | print *,'LAWYERS_15 = <',trim(lawyers),'>' 90 | 91 | !!! Syntax errors below... 92 | ! 93 | ! lawyers = 'Jones & ''Clay' ' & Davis' 94 | ! print *,'LAWYERS_15 = <',trim(lawyers),'>' 95 | ! 96 | ! lawyers = 'Jones & Clay & & 97 | ! & 98 | ! &Davis' 99 | ! print *,'LAWYERS_5 = <',trim(lawyers),'>' 100 | ! 101 | ! lawyers = 'Jones & Clay & & 102 | ! & ! just a comment? 103 | ! &Davis' 104 | ! print *,'LAWYERS_4 = <',trim(lawyers),'>' 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_unmask.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + @ 11 | y 12 | print *, @@@@@@@@,zzz 13 | zz@ 14 | @@@z = x * @ 15 | y 16 | print *, @@@@@@@@,zzz 17 | zzz = x -@ 18 | y 19 | print *, @@@@@@@@,zzz 20 | 21 | lawyers = @@@@@@@@@@@@@@@@@ 22 | @@@@@@@@@ 23 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 24 | 25 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 26 | @@@@@@@@@@ 27 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 28 | 29 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 30 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 31 | @@@@@@@@@@@ 32 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 33 | 34 | lawyers = @@@@@@@@@@@@@@@@@ 35 | 36 | @@@@@@@@@ 37 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 38 | 39 | lawyers = @@@@@@@@@@@@@@@@@ 40 | @@@@@@@@@ 41 | @@@@ 42 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 43 | 44 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 45 | @@@@@@@@@ 46 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 47 | 48 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 49 | @@@@@@@@@ 50 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 51 | 52 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 53 | @@@@@@@@@ 54 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 55 | 56 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 57 | @@@@@@@@@ 58 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 59 | 60 | lawyers = @@@@@@@@@@@@@@@@@ 61 | @@@@@ 62 | @@@@@@@@@ 63 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 64 | 65 | lawyers = @@@@@@@@@@@@@@@@@ 66 | @@@@ 67 | @@@@@@@@@ 68 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 69 | 70 | lawyers = @@@@@@@@@@@@@@ 71 | @@@@@@@@@@@@@@@@@@@ 72 | @@@@@@@ 73 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 74 | 75 | lawyers = @@@@@@@@@@@@@@@@@@@@@@ 76 | print *,@@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 77 | @@@@@ 78 | 79 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 80 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 81 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 82 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 83 | lawyers = @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 84 | @@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@ 85 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 86 | 87 | lawyers = @@@@@@@@@@@@@@@@@ 88 | @@@@@@@@@@ 89 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 90 | 91 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@ 92 | @ 93 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 94 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 95 | @ 96 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 97 | @@@@ 98 | @@@@@@@@@@ 99 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 100 | @ 101 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 102 | @@@@@@@@@@@@@@@@@@@@@@@@@ 103 | @@@@@@@@@@ 104 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/c_unmask_OK.f90: -------------------------------------------------------------------------------- 1 | 2 | program contd 3 | 4 | implicit none 5 | character (len=100) :: lawyers 6 | integer :: x, y, zzz 7 | 8 | x = 2 9 | y = 1 10 | zzz = x + @ 11 | y 12 | print *, @@@@@@@@,zzz 13 | zz@ 14 | @@@z = x * @ 15 | y 16 | print *, @@@@@@@@,zzz 17 | zzz = x -@ 18 | y 19 | print *, @@@@@@@@,zzz 20 | 21 | lawyers = @@@@@@@@@@@@@@@@@ 22 | @@@@@@@@@ 23 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 24 | 25 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 26 | @@@@@@@@@@ 27 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 28 | 29 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 30 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 31 | @@@@@@@@@@@ 32 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 33 | 34 | lawyers = @@@@@@@@@@@@@@@@@ 35 | 36 | @@@@@@@@@ 37 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 38 | 39 | lawyers = @@@@@@@@@@@@@@@@@ 40 | @@@@@@@@@ 41 | @@@@ 42 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 43 | 44 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 45 | @@@@@@@@@ 46 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 47 | 48 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 49 | @@@@@@@@@ 50 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 51 | 52 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 53 | @@@@@@@@@ 54 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 55 | 56 | lawyers = @@@@@@@@@@@@@@@@@@@@@ 57 | @@@@@@@@@ 58 | print *,@@@@@@@@@@@@@@@,trim(lawyers),@@@ 59 | 60 | lawyers = @@@@@@@@@@@@@@@@@ 61 | @@@@@ 62 | @@@@@@@@@ 63 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 64 | 65 | lawyers = @@@@@@@@@@@@@@@@@ 66 | @@@@ 67 | @@@@@@@@@ 68 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 69 | 70 | lawyers = @@@@@@@@@@@@@@ 71 | @@@@@@@@@@@@@@@@@@@ 72 | @@@@@@@ 73 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 74 | 75 | lawyers = @@@@@@@@@@@@@@@@@@@@@@ 76 | print *,@@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 77 | @@@@@ 78 | 79 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 80 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 81 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 82 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 83 | lawyers = @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 84 | @@@@@@@@@@@@@ @@@@@@@@@@@@@@@@@ 85 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 86 | 87 | lawyers = @@@@@@@@@@@@@@@@@ 88 | @@@@@@@@@@ 89 | print *,@@@@@@@@@@@@@@@@,trim(lawyers),@@@ 90 | 91 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@ 92 | @ 93 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 94 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 95 | @ 96 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 97 | @@@@ 98 | @@@@@@@@@@ 99 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 100 | @ 101 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 102 | @@@@@@@@@@@@@@@@@@@@@@@@@ 103 | @@@@@@@@@@ 104 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 105 | 106 | end program contd 107 | 108 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst_fp_OK.F90: -------------------------------------------------------------------------------- 1 | 2 | subroutine tst_fp 3 | !----------------------------------------------------------------------- 4 | use shr_kind_mod, only: fp => shr_kind_r8 5 | use blah 6 | implicit none 7 | real(r8) :: already_got_kind, xr8 8 | real :: need_a_kind, xfp 9 | 10 | xfp = 1.0 ! need a kind 11 | xfp = .2 ! need a kind 12 | xfp = 3. ! need a kind 13 | xfp = 4E0 ! need a kind 14 | xfp = 5E-1 ! need a kind 15 | xfp = 6.0E-2 ! need a kind 16 | xfp = .7E-3 ! need a kind 17 | xfp = 8.E-4 ! need a kind 18 | xfp = 9.0E5 ! need a kind 19 | xfp = .10E6 ! need a kind 20 | xfp = 11.E7 ! need a kind 21 | xfp = -1.0 ! need a kind 22 | xfp = -.2 ! need a kind 23 | xfp = -3. ! need a kind 24 | xfp = -4e0 ! need a kind 25 | xfp = -5e-1 ! need a kind 26 | xfp = -6.0e-2 ! need a kind 27 | xfp = -.7e-3 ! need a kind 28 | xfp = -8.e-4 ! need a kind 29 | xfp = -9.0e5 ! need a kind 30 | xfp = -.10e6 ! need a kind 31 | xfp = -11.e7 ! need a kind 32 | 33 | xr8 = 1.0_r8 ! do not need a kind 34 | xr8 = .2_r8 ! do not need a kind 35 | xr8 = 3._r8 ! do not need a kind 36 | xr8 = 4E0_r8 ! do not need a kind 37 | xr8 = 5E-1_r8 ! do not need a kind 38 | xr8 = 6.0E-2_r8 ! do not need a kind 39 | xr8 = .7E-3_r8 ! do not need a kind 40 | xr8 = 8.E-4_r8 ! do not need a kind 41 | xr8 = 9.0E5_r8 ! do not need a kind 42 | xr8 = .10E6_r8 ! do not need a kind 43 | xr8 = 11.E7_r8 ! do not need a kind 44 | xr8 = -1.0_r8 ! do not need a kind 45 | xr8 = -.2_r8 ! do not need a kind 46 | xr8 = -3._r8 ! do not need a kind 47 | xr8 = -4e0_r8 ! do not need a kind 48 | xr8 = -5e-1_r8 ! do not need a kind 49 | xr8 = -6.0e-2_r8! do not need a kind 50 | xr8 = -.7e-3_r8 ! do not need a kind 51 | xr8 = -8.e-4_r8 ! do not need a kind 52 | xr8 = -9.0e5_r8 ! do not need a kind 53 | xr8 = -.10e6_r8 ! do not need a kind 54 | xr8 = -11.e7_r8 ! do not need a kind 55 | 56 | blahd = 1.0d0 ! kind specified in exponent, leave kind as-is 57 | blahd = -1.0D0 ! kind specified in exponent, leave kind as-is 58 | 59 | IF ( xfp.lt.1 ) THEN ! leave as-is 60 | print 'xfp.lt.1' ! leave as-is 61 | ENDIF 62 | IF ( xfp.lt.1. ) THEN ! need a kind 63 | print 'xfp.lt.1.' ! leave as-is 64 | ENDIF 65 | IF ( 1.lt.xfp ) THEN ! leave as-is 66 | print '1.lt.xfp' ! leave as-is 67 | ENDIF 68 | IF ( 1..lt.xfp ) THEN ! need a kind 69 | print '1..lt.xfp.' ! leave as-is 70 | ENDIF 71 | 72 | blahr = a3d0var ! leave as-is 73 | blahr = a3e0var ! leave as-is 74 | 75 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) ! do not need a kind 76 | 77 | blahr=a3d0var ! leave as-is 78 | blahr=a3e0var ! leave as-is 79 | 80 | end subroutine tst_fp 81 | 82 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_04_12/tc_maskedString.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'test/unit' 4 | require 'maskedString' 5 | 6 | 7 | class TestMaskedString 8 | 9 | attr_reader :errorMsg 10 | 11 | def initialize(in_str, in_mask, outstr_mask_OK, outstr_unmask_OK) 12 | @instr = in_str 13 | @inmask = in_mask 14 | @outstrmask_OK = outstr_mask_OK 15 | @outstrunmask_OK = outstr_unmask_OK 16 | end 17 | 18 | def mask_unmask_correct? 19 | ms = MaskedString.new(@instr, @inmask) 20 | @outstrmask = ms.get_masked 21 | @outstrunmask = ms.get_unmasked 22 | @errorMsg = "" 23 | resultOK?(@outstrmask_OK, @outstrmask, "MASKED STRINGS") 24 | resultOK?(@outstrunmask_OK, @outstrunmask, "UNMASKED STRINGS") 25 | end 26 | 27 | def resultOK?(expected, actual, errorHeader) 28 | ret = (expected == actual) 29 | @errorMsg = "NO ERROR\n" 30 | unless ret then 31 | @errorMsg = "ERROR IN #{errorHeader}:\n" 32 | @errorMsg << "EXPECTED: <#{expected}>\n" 33 | @errorMsg << "BUT GOT: <#{actual}>\n" 34 | end 35 | ret 36 | end 37 | 38 | end # class TestMaskedString 39 | 40 | 41 | 42 | class TC_MaskedString < Test::Unit::TestCase 43 | 44 | def setup 45 | @masktests = [] 46 | @masktests << TestMaskedString.new( 47 | "0123456789", 48 | [], 49 | "UUUUUUUUUU", 50 | "0123456789" ) 51 | @masktests << TestMaskedString.new( 52 | "0123456789", 53 | [ (0..9) ], 54 | "0123456789", 55 | "MMMMMMMMMM" ) 56 | @masktests << TestMaskedString.new( 57 | "0123456789", 58 | [ (1..3), (6..8) ], 59 | "U123UU678U", 60 | "0MMM45MMM9" ) 61 | @masktests << TestMaskedString.new( 62 | "0123456789", 63 | [ (1..3), (4..8) ], 64 | "U12345678U", 65 | "0MMMMMMMM9" ) 66 | @masktests << TestMaskedString.new( 67 | "0123456789", 68 | [ (0..1), (3..5) ], 69 | "01U345UUUU", 70 | "MM2MMM6789" ) 71 | @masktests << TestMaskedString.new( 72 | "0123456789", 73 | [ (0..1), (3...6) ], 74 | "01U345UUUU", 75 | "MM2MMM6789" ) 76 | @masktests << TestMaskedString.new( 77 | "0123456789", 78 | [ (1...4), (4...9) ], 79 | "U12345678U", 80 | "0MMMMMMMM9" ) 81 | #$$$here... add tests to ensure that execeptions are raised when expected 82 | end 83 | 84 | def test_masks 85 | @masktests.each do |masktest| 86 | assert(masktest.mask_unmask_correct?, masktest.errorMsg) 87 | end 88 | end 89 | 90 | def teardown 91 | end 92 | 93 | end # class TC_MaskedString 94 | 95 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_statements.F90: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, 36 | #include 37 | ) 38 | INTEGER, INTENT(INOUT) :: x 39 | return 40 | end subroutine fake1 41 | 42 | subroutine fake11 ( 43 | #include 44 | y, 45 | #include 46 | #include 47 | z ) 48 | INTEGER, INTENT(INOUT) :: y,z 49 | return 50 | end subroutine fake11 51 | 52 | real function need_kind 53 | need_kind = 0. 54 | end function need_kind 55 | 56 | real(r8) function leave_as_is 57 | leave_as_is = 0._r8 58 | end function leave_as_is 59 | 60 | end module fakeo 61 | 62 | 63 | module FakE2 64 | 65 | private 66 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) 67 | public NEED_KInd2 68 | 69 | contains 70 | 71 | subroutine fake21 ( a,b,c, 72 | #ifdef X21 73 | d, 74 | #else 75 | e, 76 | #endif 77 | ) 78 | INTEGER, INTENT(INOUT) :: a,b,c 79 | #ifdef X21 80 | INTEGER, INTENT(INOUT) :: d 81 | #else 82 | INTEGER, INTENT(INOUT) :: e 83 | #endif 84 | return 85 | end subroutine fake21 86 | 87 | real function need_kind2 88 | need_kind2 = 0. 89 | end function need_kind2 90 | 91 | real(r8) function leave_as_is2 92 | leave_as_is2 = 0._r8 93 | end function leave_as_is2 94 | 95 | end module faKE2 96 | 97 | 98 | 99 | 100 | subroutine tst1 (lchnk ,ncol , q ) 101 | 102 | 103 | 104 | 105 | 106 | 107 | use module_fp, only: r8 => wrf_kind_r8 108 | 109 | 110 | 111 | 112 | implicit none 113 | 114 | integer fake_not_in_module 115 | integer niter 116 | parameter (niter = 15) 117 | integer, parameter :: pcols = 1 118 | integer, parameter :: pver = 1 119 | 120 | 121 | 122 | 123 | integer, intent(in) :: lchnk 124 | integer, intent(in) :: ncol 125 | real(r8), intent(inout) :: q(pcols,pver) 126 | 127 | WRITE(wrf_err_message,*) 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 128 | 129 | 130 | 131 | 132 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 133 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 134 | end subroutine tst1 135 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_statements_OK.F90: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, 36 | #include 37 | ) 38 | INTEGER, INTENT(INOUT) :: x 39 | return 40 | end subroutine fake1 41 | 42 | subroutine fake11 ( 43 | #include 44 | y, 45 | #include 46 | #include 47 | z ) 48 | INTEGER, INTENT(INOUT) :: y,z 49 | return 50 | end subroutine fake11 51 | 52 | real function need_kind 53 | need_kind = 0. 54 | end function need_kind 55 | 56 | real(r8) function leave_as_is 57 | leave_as_is = 0._r8 58 | end function leave_as_is 59 | 60 | end module fakeo 61 | 62 | 63 | module FakE2 64 | 65 | private 66 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) 67 | public NEED_KInd2 68 | 69 | contains 70 | 71 | subroutine fake21 ( a,b,c, 72 | #ifdef X21 73 | d, 74 | #else 75 | e, 76 | #endif 77 | ) 78 | INTEGER, INTENT(INOUT) :: a,b,c 79 | #ifdef X21 80 | INTEGER, INTENT(INOUT) :: d 81 | #else 82 | INTEGER, INTENT(INOUT) :: e 83 | #endif 84 | return 85 | end subroutine fake21 86 | 87 | real function need_kind2 88 | need_kind2 = 0. 89 | end function need_kind2 90 | 91 | real(r8) function leave_as_is2 92 | leave_as_is2 = 0._r8 93 | end function leave_as_is2 94 | 95 | end module faKE2 96 | 97 | 98 | 99 | 100 | subroutine tst1 (lchnk ,ncol , q ) 101 | 102 | 103 | 104 | 105 | 106 | 107 | use module_fp, only: r8 => wrf_kind_r8 108 | 109 | 110 | 111 | 112 | implicit none 113 | 114 | integer fake_not_in_module 115 | integer niter 116 | parameter (niter = 15) 117 | integer, parameter :: pcols = 1 118 | integer, parameter :: pver = 1 119 | 120 | 121 | 122 | 123 | integer, intent(in) :: lchnk 124 | integer, intent(in) :: ncol 125 | real(r8), intent(inout) :: q(pcols,pver) 126 | 127 | WRITE(wrf_err_message,*) 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 128 | 129 | 130 | 131 | 132 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 133 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 134 | end subroutine tst1 135 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_test/FESMF_Base_C.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF_Base_C.F90,v 1.5 2004/06/13 02:42:02 svasquez Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | ! F77 interface files for C++ layer calling into F90 implementation layer. 14 | ! This cannot use any F90 syntax, including modules, or allocatable 15 | ! arrays, or ... 16 | ! 17 | !============================================================================== 18 | ! 19 | !------------------------------------------------------------------------------ 20 | ! INCLUDES 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | !============================================================================== 85 | !------------------------------------------------------------------------------ 86 | ! The following line turns the CVS identifier string into a printable variable. 87 | ! character(*), parameter, private :: version = & 88 | ! '$Id: ESMF_Base_C.F90,v 1.5 2004/06/13 02:42:02 svasquez Exp $' 89 | !============================================================================== 90 | 91 | !------------------------------------------------------------------------------ 92 | !BOP 93 | ! !DESCRIPTION: 94 | ! 95 | ! The code in this file implements the interface code between C++ and F90 96 | ! for the {\tt Base} entry points. 97 | ! 98 | !EOP 99 | !------------------------------------------------------------------------------ 100 | 101 | 102 | 103 | 104 | subroutine f_esmf_domainlistgetde(domlist, dnum, DE, rc) 105 | use ESMF_BaseTypesMod ! ESMF base class 106 | use ESMF_BaseMod ! ESMF base class 107 | 108 | type(ESMF_DomainList) :: domlist 109 | !type(ESMF_DomainList) :: domlist_t 110 | !type(ESMF_Domain) :: dd 111 | integer :: dnum 112 | !integer :: dnum_t 113 | integer :: DE 114 | !integer :: DE_t 115 | integer :: rc 116 | !integer :: rc_t 117 | 118 | !domlist_t = domlist 119 | !dnum_t = dnum 120 | !DE_t = DE 121 | !rc_t = rc 122 | 123 | !dd = domlist%domains(dnum+1) 124 | !DE_t = dd%DE 125 | 126 | DE = domlist%domains(dnum+1)%DE 127 | rc = ESMF_SUCCESS 128 | 129 | end subroutine f_esmf_domainlistgetde 130 | 131 | subroutine f_esmf_domainlistgetai(domlist, dnum, ainum, AI, rc) 132 | use ESMF_BaseTypesMod ! ESMF base class 133 | use ESMF_BaseMod ! ESMF base class 134 | 135 | type(ESMF_DomainList) :: domlist 136 | integer :: dnum 137 | integer :: ainum 138 | type(ESMF_AxisIndex) :: AI 139 | integer :: rc 140 | 141 | AI = domlist%domains(dnum+1)%ai(ainum+1) 142 | 143 | end subroutine f_esmf_domainlistgetai 144 | 145 | 146 | 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/\: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Acknowledgements: 6 | # Organization: NCAR MMM 7 | # 8 | # Description: 9 | # 10 | # This installs applications in this directory into a specified directory. 11 | # Every file named *.app will be installed as *. 12 | # 13 | # Type "ruby install.rb -h" for command-line options. 14 | # 15 | # 16 | # History: 17 | # 18 | # Version 0.1 - Initial alpha-test version. 19 | # 20 | #============================================================================== 21 | 22 | # classes used by this class 23 | require 'optparse' 24 | require 'find' 25 | require 'fortranStatements' 26 | 27 | 28 | #============================================================================== 29 | # Responsible for: 30 | # Installing all files named *_app in a user-specified directory. 31 | # Parsing command-line arguments. 32 | #============================================================================== 33 | class InstallApps 34 | 35 | # InstallApps.new 36 | def initialize 37 | # default settings 38 | @targetdir = nil 39 | @helpmsg = "\nType \"ruby #{$0} -h\" for help\n\n" 40 | if (parse_command_line) then 41 | install_apps 42 | else 43 | print "ERROR: could not parse arguments\n#{@helpmsg}" 44 | exit -1 45 | end 46 | end 47 | 48 | # returns true iff command line was successfully parsed 49 | def parse_command_line 50 | ret = true 51 | # Use OptionParser from standard library 52 | opts = OptionParser.new do |opts| 53 | opts.banner = < 2 | #include 3 | 4 | subroutine dadadj (lchnk ,ncol , pmid ,pint ,pdel ,t , q ) 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | use shr_kind_mod, only: r8 => shr_kind_r8 18 | use ppgrid 19 | use phys_grid, only: get_lat_p, get_lon_p 20 | use physconst, only: cappa 21 | 22 | implicit none 23 | 24 | integer niter 25 | parameter (niter = 15) 26 | 27 | #include 28 | 29 | 30 | 31 | integer, intent(in) :: lchnk 32 | integer, intent(in) :: ncol 33 | 34 | real(r8), intent(in) :: pmid(pcols,pver) 35 | real(r8), intent(in) :: pint(pcols,pverp) 36 | real(r8), intent(in) :: pdel(pcols,pver) 37 | 38 | 39 | 40 | 41 | real(r8), intent(inout) :: t(pcols,pver) 42 | real(r8), intent(inout) :: q(pcols,pver) 43 | 44 | 45 | 46 | integer i,k 47 | integer jiter 48 | 49 | real(r8) c1dad(pver) 50 | real(r8) c2dad(pver) 51 | real(r8) c3dad(pver) 52 | real(r8) c4dad(pver) 53 | real(r8) gammad 54 | real(r8) zeps 55 | real(r8) rdenom 56 | real(r8) dtdp 57 | real(r8) zepsdp 58 | real(r8) zgamma 59 | real(r8) qave 60 | 61 | logical ilconv 62 | logical dodad(pcols) 63 | 64 | 65 | 66 | zeps = 2.0e-5 67 | 68 | 69 | 70 | do i=1,ncol 71 | gammad = cappa*0.5*(t(i,2) + t(i,1))/pint(i,2) 72 | dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) 73 | dodad(i) = (dtdp + zeps) .gt. gammad 74 | end do 75 | do k=2,nlvdry 76 | do i=1,ncol 77 | gammad = cappa*0.5*(t(i,k+1) + t(i,k))/pint(i,k+1) 78 | dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) 79 | dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad 80 | end do 81 | end do 82 | 83 | 84 | 85 | 86 | do 80 i=1,ncol 87 | if (dodad(i)) then 88 | zeps = 2.0e-5 89 | do k=1,nlvdry 90 | c1dad(k) = cappa*0.5*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) 91 | c2dad(k) = (1. - c1dad(k))/(1. + c1dad(k)) 92 | rdenom = 1./(pdel(i,k)*c2dad(k) + pdel(i,k+1)) 93 | c3dad(k) = rdenom*pdel(i,k) 94 | c4dad(k) = rdenom*pdel(i,k+1) 95 | end do 96 | 50 do jiter=1,niter 97 | ilconv = .true. 98 | do k=1,nlvdry 99 | zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) 100 | zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) 101 | if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then 102 | ilconv = .false. 103 | t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) 104 | t(i,k) = c2dad(k)*t(i,k+1) 105 | qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) 106 | q(i,k+1) = qave 107 | q(i,k) = qave 108 | end if 109 | end do 110 | if (ilconv) go to 80 111 | end do 112 | 113 | 114 | 115 | zeps = zeps + zeps 116 | if (zeps > 1.e-4) then 117 | write(6,*)'DADADJ: No convergence in dry adiabatic adjustment' 118 | write(6,800) get_lat_p(lchnk,i),get_lon_p(lchnk,i),zeps 119 | call endrun 120 | else 121 | write(6,810) zeps,get_lat_p(lchnk,i),get_lon_p(lchnk,i) 122 | go to 50 123 | end if 124 | end if 125 | 80 continue 126 | return 127 | 128 | 129 | 130 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 131 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 132 | end subroutine dadadj 133 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/dadadj_statements_OK.F90: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | subroutine dadadj (lchnk ,ncol , pmid ,pint ,pdel ,t , q ) 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | use shr_kind_mod, only: r8 => shr_kind_r8 18 | use ppgrid 19 | use phys_grid, only: get_lat_p, get_lon_p 20 | use physconst, only: cappa 21 | 22 | implicit none 23 | 24 | integer niter 25 | parameter (niter = 15) 26 | 27 | #include 28 | 29 | 30 | 31 | integer, intent(in) :: lchnk 32 | integer, intent(in) :: ncol 33 | 34 | real(r8), intent(in) :: pmid(pcols,pver) 35 | real(r8), intent(in) :: pint(pcols,pverp) 36 | real(r8), intent(in) :: pdel(pcols,pver) 37 | 38 | 39 | 40 | 41 | real(r8), intent(inout) :: t(pcols,pver) 42 | real(r8), intent(inout) :: q(pcols,pver) 43 | 44 | 45 | 46 | integer i,k 47 | integer jiter 48 | 49 | real(r8) c1dad(pver) 50 | real(r8) c2dad(pver) 51 | real(r8) c3dad(pver) 52 | real(r8) c4dad(pver) 53 | real(r8) gammad 54 | real(r8) zeps 55 | real(r8) rdenom 56 | real(r8) dtdp 57 | real(r8) zepsdp 58 | real(r8) zgamma 59 | real(r8) qave 60 | 61 | logical ilconv 62 | logical dodad(pcols) 63 | 64 | 65 | 66 | zeps = 2.0e-5 67 | 68 | 69 | 70 | do i=1,ncol 71 | gammad = cappa*0.5*(t(i,2) + t(i,1))/pint(i,2) 72 | dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) 73 | dodad(i) = (dtdp + zeps) .gt. gammad 74 | end do 75 | do k=2,nlvdry 76 | do i=1,ncol 77 | gammad = cappa*0.5*(t(i,k+1) + t(i,k))/pint(i,k+1) 78 | dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) 79 | dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad 80 | end do 81 | end do 82 | 83 | 84 | 85 | 86 | do 80 i=1,ncol 87 | if (dodad(i)) then 88 | zeps = 2.0e-5 89 | do k=1,nlvdry 90 | c1dad(k) = cappa*0.5*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) 91 | c2dad(k) = (1. - c1dad(k))/(1. + c1dad(k)) 92 | rdenom = 1./(pdel(i,k)*c2dad(k) + pdel(i,k+1)) 93 | c3dad(k) = rdenom*pdel(i,k) 94 | c4dad(k) = rdenom*pdel(i,k+1) 95 | end do 96 | 50 do jiter=1,niter 97 | ilconv = .true. 98 | do k=1,nlvdry 99 | zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) 100 | zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) 101 | if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then 102 | ilconv = .false. 103 | t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) 104 | t(i,k) = c2dad(k)*t(i,k+1) 105 | qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) 106 | q(i,k+1) = qave 107 | q(i,k) = qave 108 | end if 109 | end do 110 | if (ilconv) go to 80 111 | end do 112 | 113 | 114 | 115 | zeps = zeps + zeps 116 | if (zeps > 1.e-4) then 117 | write(6,*)'DADADJ: No convergence in dry adiabatic adjustment' 118 | write(6,800) get_lat_p(lchnk,i),get_lon_p(lchnk,i),zeps 119 | call endrun 120 | else 121 | write(6,810) zeps,get_lat_p(lchnk,i),get_lon_p(lchnk,i) 122 | go to 50 123 | end if 124 | end if 125 | 80 continue 126 | return 127 | 128 | 129 | 130 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 131 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, ' for'/' DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', 2i5) 132 | end subroutine dadadj 133 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_test/FESMF_Fraction.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF_Fraction.F90,v 1.11 2004/12/17 22:35:44 eschwab Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | ! ESMF Fraction Module 12 | ! 13 | !============================================================================== 14 | ! 15 | ! ESMF Fraction Module 16 | module ESMF_FractionMod 17 | ! 18 | !============================================================================== 19 | ! 20 | ! This file contains the Fraction class definition and all Fraction 21 | ! class methods. 22 | ! 23 | !------------------------------------------------------------------------------ 24 | ! INCLUDES 25 | ! 26 | !=============================================================================== 27 | !BOPI 28 | ! 29 | ! !MODULE: ESMF_FractionMod 30 | ! 31 | ! !DESCRIPTION: 32 | ! Part of ESMF Fortran API wrapper of C++ implementation. 33 | ! 34 | ! Defines Fortran wrapper entry points for corresponding 35 | ! C++ implementaion of class {\tt ESMC\_Fraction}. 36 | ! 37 | ! See {\tt ../include/ESMC\_Fraction.h} for complete description. 38 | ! 39 | !------------------------------------------------------------------------------ 40 | ! !USES: 41 | use ESMF_BaseTypesMod 42 | use ESMF_BaseMod 43 | implicit none 44 | ! 45 | !------------------------------------------------------------------------------ 46 | ! !PRIVATE TYPES: 47 | private 48 | !------------------------------------------------------------------------------ 49 | ! ! ESMF_Fraction 50 | ! 51 | ! ! Fortran class type to match C++ Fraction class in size only; 52 | ! ! all dereferencing within class is performed by C++ implementation 53 | 54 | type ESMF_Fraction 55 | sequence 56 | private 57 | integer :: whole ! Integer (whole) seconds (signed) 58 | integer :: numerator ! Integer fraction (exact) n/d; numerator (signed) 59 | integer :: denominator ! Integer fraction (exact) n/d; denominator 60 | end type 61 | ! 62 | !------------------------------------------------------------------------------ 63 | ! !PUBLIC TYPES: 64 | public ESMF_Fraction 65 | !------------------------------------------------------------------------------ 66 | ! 67 | ! !PUBLIC MEMBER FUNCTIONS: 68 | 69 | ! !PRIVATE MEMBER FUNCTIONS: 70 | 71 | !EOPI 72 | 73 | !------------------------------------------------------------------------------ 74 | ! The following line turns the CVS identifier string into a printable variable. 75 | character(*), parameter, private :: version = & 76 | '$Id: ESMF_Fraction.F90,v 1.11 2004/12/17 22:35:44 eschwab Exp $' 77 | 78 | !============================================================================== 79 | 80 | contains 81 | 82 | !============================================================================== 83 | ! 84 | ! Wrappers to C++ fraction routines 85 | ! 86 | !------------------------------------------------------------------------------ 87 | ! 88 | 89 | ! dummy entry point to make ranlib stop complaining about a file 90 | ! with no symbols. TODO: replace with real code asap. nsc. 91 | subroutine ESMF_FractionDummy(rc) 92 | integer :: rc 93 | 94 | rc = ESMF_FAILURE 95 | end subroutine ESMF_FractionDummy 96 | 97 | !------------------------------------------------------------------------------ 98 | 99 | end module ESMF_FractionMod 100 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_04/addRealKind.rb: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | #============================================================================== 4 | # Author: Tom Henderson 5 | # Acknowledgements: 6 | # Organization: NCAR MMM 7 | # 8 | # Description: 9 | # 10 | # This is an application that adds a Fortran "kind" parameter to 11 | # every REAL and COMPLEX declaration, literal constant, and cast (via 12 | # intrinsic functions "REAL" and "CMPLX") where a kind parameter does 13 | # not already exist. 14 | # 15 | # Type "ruby realKindDriver.rb -h" for command-line options. 16 | # 17 | # 18 | # Assumptions: 19 | # Source code is in Fortran90/95 free form. 20 | # Source code compiles. 21 | # 22 | # 23 | # History: 24 | # 25 | # Version 0.1 - Initial alpha-test version. Supported by a large unit-test 26 | # suite. 27 | # 28 | #============================================================================== 29 | 30 | # classes used by this class 31 | require 'optparse' 32 | require 'fortranStatements' 33 | 34 | 35 | #============================================================================== 36 | # Responsible for: 37 | # Translating all files beneath a specified directory to use a specified 38 | # kind. 39 | # Parsing command-line arguments. 40 | #============================================================================== 41 | class RealKindApp 42 | 43 | attr_reader :fileName 44 | 45 | # RealKindApp.new 46 | def initialize 47 | # default settings 48 | @targetdir = "." 49 | @realKind = "fp" 50 | @verbose = false 51 | if (parse_command_line) then 52 | translate_source_files 53 | end 54 | end 55 | 56 | # returns true iff command line was successfully parsed 57 | def parse_command_line 58 | ret = true 59 | # Use OptionParser from standard library 60 | opts = OptionParser.new do |opts| 61 | opts.banner = <>\n" 107 | print "DEBUG: @realKind = <<#{@realKind}>>\n" 108 | print "DEBUG: @verbose = <<#{@verbose}>>\n" 109 | # Find.find(@targetdir) do |f| 110 | #$$$ 111 | # end 112 | end 113 | 114 | end # class RealKindApp 115 | 116 | 117 | RealKindApp.new 118 | 119 | 120 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_test/FESMF_BaseTime.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF_BaseTime.F90,v 1.15 2004/06/08 09:27:20 nscollins Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | ! ESMF BaseTime Module 14 | module ESMF_BaseTimeMod 15 | ! 16 | !============================================================================== 17 | ! 18 | ! This file contains the BaseTime class definition and all BaseTime class 19 | ! methods. 20 | ! 21 | !------------------------------------------------------------------------------ 22 | ! INCLUDES 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | ! 94 | !=============================================================================== 95 | !BOPI 96 | ! !MODULE: ESMF_BaseTimeMod - Base ESMF time definition 97 | ! 98 | ! !DESCRIPTION: 99 | ! Part of Time Manager Fortran API wrapper of C++ implemenation. 100 | ! 101 | ! This module serves only as the common Time definition inherited 102 | ! by {\tt ESMF\_TimeInterval} and {\tt ESMF\_Time}. 103 | ! 104 | ! See {\tt ../include/ESMC\_BaseTime.h} for complete description. 105 | ! 106 | !------------------------------------------------------------------------------ 107 | ! !USES: 108 | use ESMF_BaseTypesMod 109 | use ESMF_BaseMod ! ESMF Base class 110 | implicit none 111 | ! 112 | !------------------------------------------------------------------------------ 113 | ! !PRIVATE TYPES: 114 | private 115 | !------------------------------------------------------------------------------ 116 | ! ! ESMF_BaseTime 117 | ! 118 | ! ! Base class type to match C++ BaseTime class in size only; 119 | ! ! all dereferencing within class is performed by C++ implementation 120 | 121 | ! ! Equivalent sequence and kind to C++: 122 | 123 | type ESMF_BaseTime 124 | sequence ! for C++ interoperability 125 | private 126 | integer(ESMF_KIND_I8) :: s = 0 ! whole seconds 127 | integer(ESMF_KIND_I4) :: sN = 0 ! fractional seconds, numerator 128 | integer(ESMF_KIND_I4) :: sD = 0 ! fractional seconds, denominator 129 | integer :: pad1 = 0 ! to match halem C++ long[4]* 130 | integer :: pad2 = 0 ! to match halem C++ long[6]* 131 | end type 132 | 133 | !------------------------------------------------------------------------------ 134 | ! !PUBLIC TYPES: 135 | public ESMF_BaseTime 136 | !------------------------------------------------------------------------------ 137 | ! 138 | ! !PUBLIC MEMBER FUNCTIONS: 139 | ! 140 | ! None exposed at Fortran API layer; inherited through 141 | ! ESMF_TimeInterval and ESMF_Time 142 | ! 143 | !EOPI 144 | 145 | !------------------------------------------------------------------------------ 146 | ! The following line turns the CVS identifier string into a printable variable. 147 | character(*), parameter, private :: version = & 148 | '$Id: ESMF_BaseTime.F90,v 1.15 2004/06/08 09:27:20 nscollins Exp $' 149 | 150 | !------------------------------------------------------------------------------ 151 | 152 | end module ESMF_BaseTimeMod 153 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/findsymbol_test/FESMF_TimeType.f: -------------------------------------------------------------------------------- 1 | ! $Id: ESMF_TimeType.F90,v 1.2 2004/03/19 18:22:32 eschwab Exp $ 2 | ! 3 | ! Earth System Modeling Framework 4 | ! Copyright 2002-2003, University Corporation for Atmospheric Research, 5 | ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics 6 | ! Laboratory, University of Michigan, National Centers for Environmental 7 | ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, 8 | ! NASA Goddard Space Flight Center. 9 | ! Licensed under the GPL. 10 | ! 11 | !============================================================================== 12 | ! 13 | ! ESMF TimeType Module 14 | module ESMF_TimeTypeMod 15 | ! 16 | !============================================================================== 17 | ! 18 | ! This file contains the Time class definition. The Time class methods 19 | ! are defined in ESMF_Time.F90. This split is to resolve mutual 20 | ! dependency with ESMF_TimeInterval. 21 | ! 22 | !------------------------------------------------------------------------------ 23 | ! INCLUDES 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | !=============================================================================== 95 | !BOPI 96 | ! 97 | ! !MODULE: ESMF_TimeTypeMod 98 | ! 99 | ! !DESCRIPTION: 100 | ! Part of Time Manager Fortran API wrapper of C++ implemenation. 101 | ! 102 | ! Defines Fortran types for corresponding C++ class {\tt ESMC\_Time}. 103 | ! 104 | ! See {\tt ../include/ESMC\_Time.h} for complete description. 105 | ! 106 | !------------------------------------------------------------------------------ 107 | ! !USES: 108 | ! inherit from base time class 109 | use ESMF_BaseTimeMod 110 | 111 | ! associated derived types 112 | use ESMF_CalendarMod 113 | 114 | implicit none 115 | 116 | !------------------------------------------------------------------------------ 117 | ! !PRIVATE TYPES: 118 | ! None: all types defined in this file are public and propagated up 119 | ! via ESMF_TimeMod in ESMF_Time.F90 120 | 121 | !------------------------------------------------------------------------------ 122 | ! ! ESMF_Time 123 | ! 124 | ! ! Fortran class type to match C++ Time class in size only; 125 | ! ! all dereferencing within class is performed by C++ implementation 126 | 127 | ! ! Equivalent sequence and kind to C++: 128 | 129 | type ESMF_Time 130 | sequence ! match C++ storage order 131 | private ! (members opaque on Fortran side) 132 | type(ESMF_BaseTime) :: baseTime ! inherit base class 133 | type(ESMF_Calendar), pointer :: calendar => NULL() ! associated calendar 134 | integer :: timeZone = 0 ! local timezone 135 | integer :: pad = 0 ! to satisfy halem compiler 136 | end type 137 | 138 | !------------------------------------------------------------------------------ 139 | ! !PUBLIC TYPES: 140 | ! The types defined in this file are public and propagated up via 141 | ! ESMF_TimeMod in ESMF_Time.F90 142 | 143 | !EOPI 144 | 145 | !------------------------------------------------------------------------------ 146 | ! The following line turns the CVS identifier string into a printable variable. 147 | character(*), parameter, private :: version = & 148 | '$Id: ESMF_TimeType.F90,v 1.2 2004/03/19 18:22:32 eschwab Exp $' 149 | !------------------------------------------------------------------------------ 150 | 151 | end module ESMF_TimeTypeMod 152 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/orig/tst1.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/orig/tst1_repl.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module sHAmo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, sHAm1, leave_as_is, sHAm11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure sHAm1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine sHAm1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine sHAm1 46 | 47 | subroutine sHAm11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine sHAm11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module sHAmo 67 | 68 | 69 | module sHAm2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine sHAm21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine sHAm21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module sHAm2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer sHAm_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/BACKUP/05_05_03_start/argumentParser.rb: -------------------------------------------------------------------------------- 1 | 2 | #============================================================================== 3 | # Responsible for: 4 | # Parsing a string as if it were one or more arguments to a Fortran routine 5 | # and figuring out how many arguments there are. Takes parenthesis and 6 | # commas into account. nil is returned for argument count if parenthesis 7 | # do not balance. 8 | # String is assumed to contain Fortran source code that compiles, with the 9 | # possible addition of characters not recognized by Fortran. 10 | # Not responsible for detecting syntax errors. 11 | #============================================================================== 12 | class ArgumentParser 13 | 14 | attr_reader :num_args 15 | 16 | # ArgumentParser.new(aString) 17 | def initialize(args_str) 18 | @arg_str = "" + args_str 19 | @num_args = nil 20 | @arg_ranges = [] 21 | find_args 22 | end 23 | 24 | # Finds all arguments, stores their Ranges, and counts them. 25 | # Sets @num_args to nil if the string contains unbalanced parenthesis. 26 | # Sets @num_args to zero if the string is empty. 27 | def find_args 28 | if (@arg_str.length == 0) then 29 | @num_args = 0 30 | elsif (@arg_str.count("(") != @arg_str.count(")")) then 31 | @num_args = nil 32 | else 33 | # first pass, match parenthesis 34 | tmp_arg_str = "" + @arg_str 35 | offset = 0 36 | while (next_open_parens = tmp_arg_str.index(/\(/, offset)) 37 | newoffset = next_open_parens + 1 38 | next_parens = newoffset 39 | found = 1 40 | while (found > 0) 41 | next_parens = tmp_arg_str.index(/\(|\)/, newoffset) 42 | if ($& == "(") then 43 | found = found + 1 44 | else 45 | found = found - 1 46 | end 47 | newoffset = next_parens + 1 48 | if (newoffset > tmp_arg_str.length) then 49 | raise "ERROR: ran past end of string trying to find \")\"" 50 | end 51 | end 52 | # clear everything enclosed by parenthesis including parenthesis 53 | tmp_arg_str[(next_open_parens..next_parens)] = 54 | " "*(next_parens-next_open_parens+1) 55 | offset = newoffset 56 | if (offset > tmp_arg_str.length) then 57 | raise "ERROR: ran past end of string in find_args" 58 | end 59 | end 60 | # now any remaining commas should not be enclosed by parenthesis 61 | # second pass, find commas not enclosed by parenthesis 62 | offset = 0 63 | while (next_comma = tmp_arg_str.index(/,/, offset)) 64 | @arg_ranges << (offset..(next_comma-1)) 65 | offset = next_comma + 1 66 | if (offset > tmp_arg_str.length) then 67 | raise "ERROR: ran past end of string trying to find \",\"" 68 | end 69 | end 70 | # grab trailing argument, if any 71 | if (offset < tmp_arg_str.length) then 72 | @arg_ranges << (offset..(tmp_arg_str.length-1)) 73 | end 74 | @num_args = @arg_ranges.length 75 | end 76 | end 77 | 78 | def get_args 79 | ret = [] 80 | @arg_ranges.each do |range| 81 | ret << @arg_str[range] 82 | end 83 | ret 84 | end 85 | 86 | def to_s 87 | @arg_str 88 | end 89 | 90 | end # class ArgumentParser 91 | 92 | 93 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/tst1_fp.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/TESTDIR_addRealKind/tst1_repl.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module sHAmo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, sHAm1, leave_as_is, sHAm11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure sHAm1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine sHAm1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine sHAm1 46 | 47 | subroutine sHAm11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine sHAm11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module sHAmo 67 | 68 | 69 | module sHAm2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine sHAm21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine sHAm21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module sHAm2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer sHAm_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_repl.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module sHAmo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, sHAm1, leave_as_is, sHAm11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure sHAm1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine sHAm1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine sHAm1 46 | 47 | subroutine sHAm11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine sHAm11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module sHAmo 67 | 68 | 69 | module sHAm2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine sHAm21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine sHAm21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module sHAm2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer sHAm_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_repl_OK.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module sHAmo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, sHAm1, leave_as_is, sHAm11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure sHAm1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine sHAm1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine sHAm1 46 | 47 | subroutine sHAm11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine sHAm11 57 | 58 | real function need_kind ! need a kind 59 | need_kind = 0. ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module sHAmo 67 | 68 | 69 | module sHAm2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine sHAm21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine sHAm21 93 | 94 | real function need_kind2 ! need a kind 95 | need_kind2 = 0. ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module sHAm2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer sHAm_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_unmask.F90: -------------------------------------------------------------------------------- 1 | @@@@@@@@@@@@@@@@@@ 2 | @@@@@@@@@@@@@@@@@@@@ 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) @@@@@@@@@@@@@ 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, @ 36 | @ 37 | #include 38 | @ 39 | @ 40 | @ 41 | @ 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( @ 48 | #include 49 | y, @ 50 | #include 51 | #include 52 | z @ 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real function need_kind @@@@@@@@@@@@@ 59 | need_kind = 0. @@@@@@@@@@@@@ 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is @@@@@@@@@@@@@ 63 | leave_as_is = 0._r8 @@@@@@@@@@@@@ 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( @ 78 | a,b,c, @ 79 | #ifdef X21 80 | d, @ 81 | #else 82 | e, @ 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real function need_kind2 @@@@@@@@@@@@@ 95 | need_kind2 = 0. @@@@@@@@@@@@@ 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 @@@@@@@@@@@@@ 99 | leave_as_is2 = 0._r8 @@@@@@@@@@@@@ 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , @ 108 | q ) 109 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 110 | @@ 111 | @@@@@@@@@@@ 112 | @@@@@@@@@@ 113 | @@ 114 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 115 | use module_fp, only: r8 => wrf_kind_r8 116 | @@@@@@@@@@@@@@ 117 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 118 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module @@@@@@@@@@@@@@@@@@@@@@@@ 123 | integer niter @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | @@@@@@@@@@@@@@@@@@@@ 128 | @ 129 | @@@@@@@@@@@ 130 | @ 131 | integer, intent(in) :: lchnk @@@@@@@@@@@@@@@@@@ 132 | integer, intent(in) :: ncol @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 133 | real(r8), intent(inout) :: q(pcols,pver) @@@@@@@@@@@@@@@@@@@ 134 | 135 | WRITE(wrf_err_message,*) @ 136 | @@@@@@@@@@@@@@@@@@@@@@@,ims,@@@@@@@@@@@@@@@@,ime,@@@@@@,NMM_MAX_DIM, @ 137 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 138 | 139 | @ 140 | @@@@@@@@@ 141 | @ 142 | 800 format(@@@@@@@@@@@@@,2i5,@@@@@@@@@@,e9.4) 143 | 810 format(//,@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@,E9.4, @ 144 | @@@@@@/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@, @ 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/tmp/new/tst1.F90: -------------------------------------------------------------------------------- 1 | !#include 2 | !#include 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) ! 8 byte real 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) ! 4 byte real 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, & 36 | ! 37 | #include 38 | ! 39 | ! 40 | ! 41 | ! 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( & 48 | #include 49 | y, & 50 | #include 51 | #include 52 | z & 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real(r8) function need_kind ! need a kind 59 | need_kind = 0._r8 ! need a kind 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is ! leave as-is 63 | leave_as_is = 0._r8 ! leave as-is 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 ! should match different case below 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) ! 4 byte real 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( & 78 | a,b,c, & 79 | #ifdef X21 80 | d, & 81 | #else 82 | e, & 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real(r8) function need_kind2 ! need a kind 95 | need_kind2 = 0._r8 ! need a kind 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 ! leave as-is 99 | leave_as_is2 = 0._r8 ! leave as-is 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , & 108 | q ) 109 | !----------------------------------------------------------------------- 110 | ! 111 | ! Purpose: 112 | ! Method: 113 | ! 114 | !----------------------------------------------------------------------- 115 | use module_fp, only: r8 => wrf_kind_r8 116 | ! use ppgrid 117 | ! use phys_grid, only: get_lat_p, get_lon_p 118 | ! use physconst, only: cappa 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module ! fake stuff for testing 123 | integer niter ! number of iterations for convergence 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | !#include 128 | ! 129 | ! Arguments 130 | ! 131 | integer, intent(in) :: lchnk ! chunk identifier 132 | integer, intent(in) :: ncol ! number of atmospheric columns 133 | real(r8), intent(inout) :: q(pcols,pver) ! specific humidity 134 | 135 | WRITE(wrf_err_message,*) & 136 | 'start_domain_nmm ims(',ims,' > -2 or ime (',ime,') > ',NMM_MAX_DIM, & 137 | '. Increase NMM_MAX_DIM in configure.wrf, clean, and recompile.' 138 | 139 | ! 140 | ! Formats 141 | ! 142 | 800 format(' lat,lon = ',2i5,', zeps= ',e9.4) 143 | 810 format(//,'DADADJ: Convergence criterion doubled to EPS=',E9.4, & 144 | ' for'/' FAKE DRY CONVECTIVE ADJUSTMENT at Lat,Lon=', & 145 | 2i5) 146 | end subroutine tst1 147 | -------------------------------------------------------------------------------- /addrealkind/FortranTools/continuation_test/tst1_unmask_OK.F90: -------------------------------------------------------------------------------- 1 | @@@@@@@@@@@@@@@@@@ 2 | @@@@@@@@@@@@@@@@@@@@ 3 | 4 | 5 | module module_fp 6 | INTEGER, PARAMETER :: WRF_KIND_R8 = SELECTED_REAL_KIND(12) @@@@@@@@@@@@@ 7 | INTEGER, PARAMETER :: WRF_KIND_R4 = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 8 | end module module_fp 9 | 10 | 11 | module fakeo 12 | 13 | private 14 | 15 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 16 | 17 | public need_kind, fAKe1, leave_as_is, faKE11 18 | 19 | public operator(.eq.), operator(+), assignment(=) 20 | 21 | interface operator (.eq.) 22 | module procedure fake1 23 | end interface 24 | 25 | interface assignment (=) 26 | module procedure need_kind 27 | end interface 28 | 29 | interface operator (+) 30 | module procedure leave_as_is 31 | end interface 32 | 33 | contains 34 | 35 | subroutine fake1 ( x, @ 36 | @ 37 | #include 38 | @ 39 | @ 40 | @ 41 | @ 42 | ) 43 | INTEGER, INTENT(INOUT) :: x 44 | return 45 | end subroutine fake1 46 | 47 | subroutine fake11 ( @ 48 | #include 49 | y, @ 50 | #include 51 | #include 52 | z @ 53 | ) 54 | INTEGER, INTENT(INOUT) :: y,z 55 | return 56 | end subroutine fake11 57 | 58 | real function need_kind @@@@@@@@@@@@@ 59 | need_kind = 0. @@@@@@@@@@@@@ 60 | end function need_kind 61 | 62 | real(r8) function leave_as_is @@@@@@@@@@@@@ 63 | leave_as_is = 0._r8 @@@@@@@@@@@@@ 64 | end function leave_as_is 65 | 66 | end module fakeo 67 | 68 | 69 | module FakE2 @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 70 | 71 | private 72 | INTEGER, PARAMETER :: fp = SELECTED_REAL_KIND( 6) @@@@@@@@@@@@@ 73 | public NEED_KInd2 74 | 75 | contains 76 | 77 | subroutine fake21 ( @ 78 | a,b,c, @ 79 | #ifdef X21 80 | d, @ 81 | #else 82 | e, @ 83 | #endif 84 | ) 85 | INTEGER, INTENT(INOUT) :: a,b,c 86 | #ifdef X21 87 | INTEGER, INTENT(INOUT) :: d 88 | #else 89 | INTEGER, INTENT(INOUT) :: e 90 | #endif 91 | return 92 | end subroutine fake21 93 | 94 | real function need_kind2 @@@@@@@@@@@@@ 95 | need_kind2 = 0. @@@@@@@@@@@@@ 96 | end function need_kind2 97 | 98 | real(r8) function leave_as_is2 @@@@@@@@@@@@@ 99 | leave_as_is2 = 0._r8 @@@@@@@@@@@@@ 100 | end function leave_as_is2 101 | 102 | end module faKE2 103 | 104 | 105 | 106 | 107 | subroutine tst1 (lchnk ,ncol , @ 108 | q ) 109 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 110 | @@ 111 | @@@@@@@@@@@ 112 | @@@@@@@@@@ 113 | @@ 114 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 115 | use module_fp, only: r8 => wrf_kind_r8 116 | @@@@@@@@@@@@@@ 117 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 118 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 119 | 120 | implicit none 121 | 122 | integer fake_not_in_module @@@@@@@@@@@@@@@@@@@@@@@@ 123 | integer niter @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 124 | parameter (niter = 15) 125 | integer, parameter :: pcols = 1 126 | integer, parameter :: pver = 1 127 | @@@@@@@@@@@@@@@@@@@@ 128 | @ 129 | @@@@@@@@@@@ 130 | @ 131 | integer, intent(in) :: lchnk @@@@@@@@@@@@@@@@@@ 132 | integer, intent(in) :: ncol @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 133 | real(r8), intent(inout) :: q(pcols,pver) @@@@@@@@@@@@@@@@@@@ 134 | 135 | WRITE(wrf_err_message,*) @ 136 | @@@@@@@@@@@@@@@@@@@@@@@,ims,@@@@@@@@@@@@@@@@,ime,@@@@@@,NMM_MAX_DIM, @ 137 | @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ 138 | 139 | @ 140 | @@@@@@@@@ 141 | @ 142 | 800 format(@@@@@@@@@@@@@,2i5,@@@@@@@@@@,e9.4) 143 | 810 format(//,@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@,E9.4, @ 144 | @@@@@@/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@, @ 145 | 2i5) 146 | end subroutine tst1 147 | --------------------------------------------------------------------------------