├── README.md └── SCRIP ├── .log.dti ├── bugs ├── build ├── GNUmakefile ├── GNUmakefileTest ├── GNUmakefileTestRepeat ├── compile.mk ├── depends.mk ├── fdepends.awk ├── linuxabsoft_serial.gnu ├── linuxg95_serial.gnu ├── linuxgfortran_serial.gnu ├── linuxintel_serial.gnu └── preprocess.mk ├── doc ├── SCRIPusers.pdf ├── SCRIPusers.ps └── SCRIPusers.tex ├── drivers ├── SCRIP_driver.F90 ├── scrip_test.f └── scrip_test_repeat.f ├── grids ├── CreateLatLon.F90 ├── OverlayGMV.F90 ├── README ├── convertPOPT.f ├── convert_old.f ├── convertgauss.f ├── makefile ├── remap_grid_POP43.nc └── remap_grid_T42.nc ├── scrip_in ├── scrip_test_in ├── setupTargetDir └── source ├── SCRIP_ConfigMod.F90 ├── SCRIP_ErrorMod.F90 ├── SCRIP_IOUnitsMod.F90 ├── SCRIP_InitMod.F90 ├── SCRIP_KindsMod.F90 ├── SCRIP_NetcdfMod.F90 ├── SCRIP_RemapParticleMod.F90 ├── constants.f ├── copyright ├── grids.f ├── mpi ├── SCRIP_BroadcastMod.F90 └── SCRIP_CommMod.F90 ├── remap_bicubic.f ├── remap_bilinear.f ├── remap_conservative.f ├── remap_distance_weight.f ├── remap_mod.f ├── remap_read.f ├── remap_vars.f ├── remap_write.f ├── serial ├── SCRIP_BroadcastMod.F90 └── SCRIP_CommMod.F90 └── timers.f /README.md: -------------------------------------------------------------------------------- 1 | # SCRIP 2 | SCRIP is a software package which computes addresses and weights for remapping and interpolating fields between grids in 3 | spherical coordinates. It was written originally for remapping fields to other grids in a coupled climate model, but is 4 | sufficiently general that it can be used in other applications as well. The package should work for any grid on the surface 5 | of a sphere. SCRIP currently supports five remapping options: 6 | 7 | * Conservative remapping: First- and second-order conservative remapping as described in Jones (1999, Monthly Weather Review, 127, 2204-2210). 8 | * Bilinear interpolation: Slightly generalized to use a local bilinear approximation (only logically-rectangular grids). 9 | * Bicubic interpolation: Similarly generalized (only logically-rectangular grids). 10 | * Distance-weighted averaging: Inverse-distance-weighted average of a user-specified number of nearest neighbor values. 11 | * Particle remapping: A conservative particle (Monte-Carlo-like) remapping scheme 12 | -------------------------------------------------------------------------------- /SCRIP/.log.dti: -------------------------------------------------------------------------------- 1 | 96/10/22 13:08:53 opened .log.dti 2 | 96/10/22 13:08:53 debug explicitly set to 0 3 | 96/10/22 13:08:58 opened .log.dti 4 | 96/10/22 13:08:58 debug explicitly set to 0 5 | 96/10/22 13:09:56 opened .log.dti 6 | 96/10/22 13:09:56 debug explicitly set to 0 7 | 96/11/18 11:29:28 opened .log.dti 8 | 96/11/18 11:29:28 debug explicitly set to 0 9 | 96/11/18 11:29:31 opened .log.dti 10 | 96/11/18 11:29:31 debug explicitly set to 0 11 | 96/11/18 11:31:34 opened .log.dti 12 | 96/11/18 11:31:34 debug explicitly set to 0 13 | 96/11/20 09:09:51 opened .log.dti 14 | 96/11/20 09:09:51 debug explicitly set to 0 15 | 96/11/20 09:09:55 opened .log.dti 16 | 96/11/20 09:09:55 debug explicitly set to 0 17 | -------------------------------------------------------------------------------- /SCRIP/bugs: -------------------------------------------------------------------------------- 1 | ************************************************************************ 2 | 3 | Bug or issue Reported Fixed 4 | ---------------------------------------------------- -------- -------- 5 | 6 | Outstanding: 7 | 8 | Need parallel implementation of SCRIP 07/01/00 9 | Latitude bins not very robust for sparse grids 10/27/98 10 | Deal with extrapolation for bilinear, bicubic 12/02/98 11 | Remove cyclic bndy assumptions from bilin, bicubic 12/02/98 12 | Problem with coordinate transform when both grids 13 | contain pole point as cell edge (note that in 14 | such a case, turning off the coordinate transform 15 | by setting thresholds >pi, <-pi may fix this) 12/03/98 16 | Bug in test configuration when SH transformation on 12/03/98 17 | 18 | Fixed in release 1.4: 19 | 20 | Conversion from polar projection back to lat/lon 21 | space extremely sensitive near pole 07/01/01 08/20/01 22 | Bilinear/cubic fails when cells overlap longitude cut 08/13/01 08/20/01 23 | Bilinear/cubic iteration converges to bad solution 24 | for skewed cells 08/21/01 08/21/01 25 | Nearest-neighbor backup to bilinear/cubic fails 08/13/01 08/20/01 26 | Added feature to use input areas for normalization 06/20/00 07/01/00 27 | Added error checks on weights for conservative maps 06/20/00 07/01/00 28 | 29 | Fixed in release 1.3: 30 | 31 | Added new binning options to restrict searches ...do not know... 32 | Optimized code for resizing arrays ................. 33 | 34 | Fixed in release 1.2: 35 | 36 | Changed namelist input for map type to character 05/31/99 06/04/99 37 | Added new output option for CSM coupler 05/31/99 06/04/99 38 | Added additional normalization options for conserv 05/31/99 06/04/99 39 | Improper handling of grid pairs which share corners 01/29/99 02/04/99 40 | Uninitialized variables and subscripts out of range 01/22/99 01/25/99 41 | 42 | Fixed in release 1.1: 43 | 44 | Conservative remap assumed num_maps = 2 12/16/98 12/17/98 45 | Change units of grid quantities back to input units 12/04/98 12/17/98 46 | Add option for unnormalized conservative weights 12/04/98 12/17/98 47 | Update user's guide for recent changes 12/02/98 12/17/98 48 | Add different test fields 11/18/98 12/02/98 49 | Add support for multiple remap test 11/18/98 12/02/98 50 | Add bicubic module 11/18/98 12/17/98 51 | 52 | Fixed in release 1.02: 53 | 54 | Problems setting up latitude bins for polar cells 10/22/98 10/27/98 55 | Input latitudes out of range (due to machine pi/2) 10/27/98 10/27/98 56 | Bad coordinate transformation in south pole 10/22/98 11/02/98 57 | 58 | ************************************************************************ 59 | -------------------------------------------------------------------------------- /SCRIP/build/GNUmakefile: -------------------------------------------------------------------------------- 1 | # 2 | # File: GNUmakefile 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This is the main driver makefile for compiling SCRIP. It relies on 7 | # sub-makefiles to perform preprocessing, dependency analysis and compiling. 8 | # 9 | # Several variables must be set either as environment variables or on the 10 | # command line (e.g. make SCRIPDIR=/your/path). These variables are: 11 | # 12 | # SCRIPEXEDIR = the directory where you want the executable to end up. A 13 | # common value might be . (the current working directory) 14 | # SCRIPDIR = the path to the SCRIP distribution from which you want 15 | # to grab source files, etc. This should be the path to the 16 | # top level SCRIP directory, not the individual source,mpi 17 | # directories. 18 | # SCRIPARCH = the base name of a file in the build directory where 19 | # architecture and location-specific information is defined 20 | # 21 | # The optimize variable has a default value of yes and can not be set 22 | # as an environment variable. It can only be changed to no via the 23 | # command line. 24 | # OPTIMIZE = yes/no whether you want full optimization or no optimization 25 | # 26 | #---------------------------------------------------------------------------- 27 | # 28 | # The bourne shell is safest for make 29 | SHELL = /bin/sh 30 | # 31 | # 32 | # By default, you build optimized code. To override, add "OPTIMIZE=no" 33 | # to the make command line. 34 | OPTIMIZE = yes 35 | # 36 | #---------------------------------------------------------------------------- 37 | # 38 | # Check that path variables SCRIPEXEDIR, SCRIPDIR have been set. 39 | # 40 | #---------------------------------------------------------------------------- 41 | 42 | VARSDEFINED = 43 | 44 | ifneq (,$(SCRIPEXEDIR)) 45 | VARSDEFINED := $(VARSDEFINED)SCRIPEXEDIR 46 | export SCRIPEXEDIR 47 | else 48 | bogusexedir: 49 | @echo " Please setenv SCRIPEXEDIR" 50 | endif 51 | 52 | ifneq (,$(SCRIPDIR)) 53 | VARSDEFINED := $(VARSDEFINED)SCRIPDIR 54 | export SCRIPDIR 55 | else 56 | bogusSCRIPdir: 57 | @echo " Please setenv SCRIPDIR" 58 | endif 59 | 60 | # Set the directory where dependency info will reside. 61 | DepDir = $(SCRIPEXEDIR)/compile/Depends 62 | 63 | #---------------------------------------------------------------------------- 64 | # 65 | # Include architecture-specific flags and options. 66 | # 67 | #---------------------------------------------------------------------------- 68 | 69 | ifneq (,$(SCRIPARCH)) 70 | export SCRIPARCH 71 | VARSDEFINED := $(VARSDEFINED)SCRIPARCH 72 | ifneq (,$(SCRIPDIR)) 73 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 74 | endif 75 | else 76 | bogusSCRIParch: 77 | @echo " Please setenv SCRIPARCH" 78 | endif 79 | 80 | #---------------------------------------------------------------------------- 81 | # 82 | # Define a symbol (TARGETX) for the executable name (SCRIP) 83 | # 84 | #---------------------------------------------------------------------------- 85 | 86 | TARGETX = scrip 87 | 88 | ifeq ($(OPTIMIZE),no) 89 | # If building a debug version, append "_db" to the executable name 90 | TARGETX = scrip_db 91 | endif 92 | 93 | #---------------------------------------------------------------------------- 94 | # 95 | # Make the SCRIP executable 96 | # 97 | #---------------------------------------------------------------------------- 98 | 99 | .PHONY: depends preprocess compile dirs 100 | 101 | $(TARGETX): depends 102 | @echo " GNUmakefile is making target '$(TARGETX)'" 103 | @make -f $(SCRIPDIR)/build/compile.mk SCRIPEXEDIR=$(SCRIPEXEDIR) SCRIPDIR=$(SCRIPDIR) OPTIMIZE=$(OPTIMIZE) TARGETX=$(TARGETX) 104 | 105 | #---------------------------------------------------------------------------- 106 | # 107 | # Create the file dependencies for compiling. 108 | # 109 | #---------------------------------------------------------------------------- 110 | 111 | depends: preprocess 112 | @echo "$(SCRIPEXEDIR) $(SCRIPDIR)" 113 | @echo "$(SCRIPARCH) automatically generating dependencies for compiling" 114 | @make -f $(SCRIPDIR)/build/depends.mk SCRIPEXEDIR=$(SCRIPEXEDIR) OPTIMIZE=$(OPTIMIZE) 115 | 116 | #---------------------------------------------------------------------------- 117 | # 118 | # Perform the preprocessing 119 | # 120 | #---------------------------------------------------------------------------- 121 | 122 | preprocess: dirs 123 | @echo "$(SCRIPARCH) preprocess SCRIP source" 124 | @make -f $(SCRIPDIR)/build/preprocess.mk 125 | 126 | #---------------------------------------------------------------------------- 127 | # 128 | # Create the directory structure if it does not exist. 129 | # 130 | #---------------------------------------------------------------------------- 131 | 132 | dirs: 133 | @echo "$(SCRIPARCH) is creating the required directory structure" 134 | @cd $(SCRIPEXEDIR) && if [ ! -d compile ]; then mkdir compile; fi 135 | @cd $(SCRIPEXEDIR)/compile && \ 136 | if [ ! -d Depends ]; then mkdir Depends; fi 137 | @cd $(SCRIPEXEDIR) 138 | 139 | #---------------------------------------------------------------------------- 140 | # 141 | # Include utilities makefile with rules for clean, clobber, etc. 142 | # 143 | #---------------------------------------------------------------------------- 144 | 145 | clean: 146 | ifeq ($(VARSDEFINED),SCRIPEXEDIRSCRIPDIRSCRIPARCH) 147 | @cd $(SCRIPEXEDIR) && $(RM) core scrip scrip_db 148 | @cd $(SCRIPEXEDIR) && $(RM) compile/Depends/*.* 149 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.f compile/*.f90 compile/*.c 150 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.o compile/*.$(MODSUF) 151 | else 152 | @echo " Please setenv SCRIPEXEDIR SCRIPDIR and SCRIPARCH" 153 | @echo " Only $(VARSDEFINED) have been defined." 154 | endif 155 | 156 | #---------------------------------------------------------------------------- 157 | -------------------------------------------------------------------------------- /SCRIP/build/GNUmakefileTest: -------------------------------------------------------------------------------- 1 | # 2 | # File: GNUmakefile 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This is the main driver makefile for compiling SCRIP. It relies on 7 | # sub-makefiles to perform preprocessing, dependency analysis and compiling. 8 | # 9 | # Several variables must be set either as environment variables or on the 10 | # command line (e.g. make SCRIPDIR=/your/path). These variables are: 11 | # 12 | # SCRIPEXEDIR = the directory where you want the executable to end up. A 13 | # common value might be . (the current working directory) 14 | # SCRIPDIR = the path to the SCRIP distribution from which you want 15 | # to grab source files, etc. This should be the path to the 16 | # top level SCRIP directory, not the individual source,mpi 17 | # directories. 18 | # SCRIPARCH = the base name of a file in the build directory where 19 | # architecture and location-specific information is defined 20 | # 21 | # The optimize variable has a default value of yes and can not be set 22 | # as an environment variable. It can only be changed to no via the 23 | # command line. 24 | # OPTIMIZE = yes/no whether you want full optimization or no optimization 25 | # 26 | #---------------------------------------------------------------------------- 27 | # 28 | # The bourne shell is safest for make 29 | SHELL = /bin/sh 30 | # 31 | # 32 | # By default, you build optimized code. To override, add "OPTIMIZE=no" 33 | # to the make command line. 34 | OPTIMIZE = yes 35 | # 36 | #---------------------------------------------------------------------------- 37 | # 38 | # Check that path variables SCRIPEXEDIR, SCRIPDIR have been set. 39 | # 40 | #---------------------------------------------------------------------------- 41 | 42 | VARSDEFINED = 43 | 44 | ifneq (,$(SCRIPEXEDIR)) 45 | VARSDEFINED := $(VARSDEFINED)SCRIPEXEDIR 46 | export SCRIPEXEDIR 47 | else 48 | bogusexedir: 49 | @echo " Please setenv SCRIPEXEDIR" 50 | endif 51 | 52 | ifneq (,$(SCRIPDIR)) 53 | VARSDEFINED := $(VARSDEFINED)SCRIPDIR 54 | export SCRIPDIR 55 | else 56 | bogusSCRIPdir: 57 | @echo " Please setenv SCRIPDIR" 58 | endif 59 | 60 | # Set the directory where dependency info will reside. 61 | DepDir = $(SCRIPEXEDIR)/compile/Depends 62 | 63 | #---------------------------------------------------------------------------- 64 | # 65 | # Include architecture-specific flags and options. 66 | # 67 | #---------------------------------------------------------------------------- 68 | 69 | ifneq (,$(SCRIPARCH)) 70 | export SCRIPARCH 71 | VARSDEFINED := $(VARSDEFINED)SCRIPARCH 72 | ifneq (,$(SCRIPDIR)) 73 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 74 | endif 75 | else 76 | bogusSCRIParch: 77 | @echo " Please setenv SCRIPARCH" 78 | endif 79 | 80 | #---------------------------------------------------------------------------- 81 | # 82 | # Define a symbol (TARGETX) for the executable name (SCRIP) 83 | # 84 | #---------------------------------------------------------------------------- 85 | 86 | TARGETX = scrip_test 87 | 88 | ifeq ($(OPTIMIZE),no) 89 | # If building a debug version, append "_db" to the executable name 90 | TARGETX = scrip_test_db 91 | endif 92 | 93 | #---------------------------------------------------------------------------- 94 | # 95 | # Make the SCRIP executable 96 | # 97 | #---------------------------------------------------------------------------- 98 | 99 | .PHONY: depends preprocess compile dirs 100 | 101 | $(TARGETX): depends 102 | @echo " GNUmakefile is making target '$(TARGETX)'" 103 | @make -f $(SCRIPDIR)/build/compile.mk SCRIPEXEDIR=$(SCRIPEXEDIR) SCRIPDIR=$(SCRIPDIR) OPTIMIZE=$(OPTIMIZE) TARGETX=$(TARGETX) 104 | 105 | #---------------------------------------------------------------------------- 106 | # 107 | # Create the file dependencies for compiling. 108 | # 109 | #---------------------------------------------------------------------------- 110 | 111 | depends: preprocess 112 | @echo "$(SCRIPEXEDIR) $(SCRIPDIR)" 113 | @echo "$(SCRIPARCH) automatically generating dependencies for compiling" 114 | @make -f $(SCRIPDIR)/build/depends.mk SCRIPEXEDIR=$(SCRIPEXEDIR) OPTIMIZE=$(OPTIMIZE) 115 | 116 | #---------------------------------------------------------------------------- 117 | # 118 | # Perform the preprocessing 119 | # 120 | #---------------------------------------------------------------------------- 121 | 122 | preprocess: dirs 123 | @echo "$(SCRIPARCH) preprocess SCRIP source" 124 | @make -f $(SCRIPDIR)/build/preprocess.mk 125 | 126 | #---------------------------------------------------------------------------- 127 | # 128 | # Create the directory structure if it does not exist. 129 | # 130 | #---------------------------------------------------------------------------- 131 | 132 | dirs: 133 | @echo "$(SCRIPARCH) is creating the required directory structure" 134 | @cd $(SCRIPEXEDIR) && if [ ! -d compile ]; then mkdir compile; fi 135 | @cd $(SCRIPEXEDIR)/compile && \ 136 | if [ ! -d Depends ]; then mkdir Depends; fi 137 | @cd $(SCRIPEXEDIR) 138 | 139 | #---------------------------------------------------------------------------- 140 | # 141 | # Include utilities makefile with rules for clean, clobber, etc. 142 | # 143 | #---------------------------------------------------------------------------- 144 | 145 | clean: 146 | ifeq ($(VARSDEFINED),SCRIPEXEDIRSCRIPDIRSCRIPARCH) 147 | @cd $(SCRIPEXEDIR) && $(RM) core scrip scrip_db 148 | @cd $(SCRIPEXEDIR) && $(RM) compile/Depends/*.* 149 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.f compile/*.f90 compile/*.c 150 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.o compile/*.$(MODSUF) 151 | else 152 | @echo " Please setenv SCRIPEXEDIR SCRIPDIR and SCRIPARCH" 153 | @echo " Only $(VARSDEFINED) have been defined." 154 | endif 155 | 156 | #---------------------------------------------------------------------------- 157 | -------------------------------------------------------------------------------- /SCRIP/build/GNUmakefileTestRepeat: -------------------------------------------------------------------------------- 1 | # 2 | # File: GNUmakefile 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This is the main driver makefile for compiling SCRIP. It relies on 7 | # sub-makefiles to perform preprocessing, dependency analysis and compiling. 8 | # 9 | # Several variables must be set either as environment variables or on the 10 | # command line (e.g. make SCRIPDIR=/your/path). These variables are: 11 | # 12 | # SCRIPEXEDIR = the directory where you want the executable to end up. A 13 | # common value might be . (the current working directory) 14 | # SCRIPDIR = the path to the SCRIP distribution from which you want 15 | # to grab source files, etc. This should be the path to the 16 | # top level SCRIP directory, not the individual source,mpi 17 | # directories. 18 | # SCRIPARCH = the base name of a file in the build directory where 19 | # architecture and location-specific information is defined 20 | # 21 | # The optimize variable has a default value of yes and can not be set 22 | # as an environment variable. It can only be changed to no via the 23 | # command line. 24 | # OPTIMIZE = yes/no whether you want full optimization or no optimization 25 | # 26 | #---------------------------------------------------------------------------- 27 | # 28 | # The bourne shell is safest for make 29 | SHELL = /bin/sh 30 | # 31 | # 32 | # By default, you build optimized code. To override, add "OPTIMIZE=no" 33 | # to the make command line. 34 | OPTIMIZE = yes 35 | # 36 | #---------------------------------------------------------------------------- 37 | # 38 | # Check that path variables SCRIPEXEDIR, SCRIPDIR have been set. 39 | # 40 | #---------------------------------------------------------------------------- 41 | 42 | VARSDEFINED = 43 | 44 | ifneq (,$(SCRIPEXEDIR)) 45 | VARSDEFINED := $(VARSDEFINED)SCRIPEXEDIR 46 | export SCRIPEXEDIR 47 | else 48 | bogusexedir: 49 | @echo " Please setenv SCRIPEXEDIR" 50 | endif 51 | 52 | ifneq (,$(SCRIPDIR)) 53 | VARSDEFINED := $(VARSDEFINED)SCRIPDIR 54 | export SCRIPDIR 55 | else 56 | bogusSCRIPdir: 57 | @echo " Please setenv SCRIPDIR" 58 | endif 59 | 60 | # Set the directory where dependency info will reside. 61 | DepDir = $(SCRIPEXEDIR)/compile/Depends 62 | 63 | #---------------------------------------------------------------------------- 64 | # 65 | # Include architecture-specific flags and options. 66 | # 67 | #---------------------------------------------------------------------------- 68 | 69 | ifneq (,$(SCRIPARCH)) 70 | export SCRIPARCH 71 | VARSDEFINED := $(VARSDEFINED)SCRIPARCH 72 | ifneq (,$(SCRIPDIR)) 73 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 74 | endif 75 | else 76 | bogusSCRIParch: 77 | @echo " Please setenv SCRIPARCH" 78 | endif 79 | 80 | #---------------------------------------------------------------------------- 81 | # 82 | # Define a symbol (TARGETX) for the executable name (SCRIP) 83 | # 84 | #---------------------------------------------------------------------------- 85 | 86 | TARGETX = scrip_test_repeat 87 | 88 | ifeq ($(OPTIMIZE),no) 89 | # If building a debug version, append "_db" to the executable name 90 | TARGETX = scrip_test_repeat_db 91 | endif 92 | 93 | #---------------------------------------------------------------------------- 94 | # 95 | # Make the SCRIP executable 96 | # 97 | #---------------------------------------------------------------------------- 98 | 99 | .PHONY: depends preprocess compile dirs 100 | 101 | $(TARGETX): depends 102 | @echo " GNUmakefile is making target '$(TARGETX)'" 103 | @make -f $(SCRIPDIR)/build/compile.mk SCRIPEXEDIR=$(SCRIPEXEDIR) SCRIPDIR=$(SCRIPDIR) OPTIMIZE=$(OPTIMIZE) TARGETX=$(TARGETX) 104 | 105 | #---------------------------------------------------------------------------- 106 | # 107 | # Create the file dependencies for compiling. 108 | # 109 | #---------------------------------------------------------------------------- 110 | 111 | depends: preprocess 112 | @echo "$(SCRIPEXEDIR) $(SCRIPDIR)" 113 | @echo "$(SCRIPARCH) automatically generating dependencies for compiling" 114 | @make -f $(SCRIPDIR)/build/depends.mk SCRIPEXEDIR=$(SCRIPEXEDIR) OPTIMIZE=$(OPTIMIZE) 115 | 116 | #---------------------------------------------------------------------------- 117 | # 118 | # Perform the preprocessing 119 | # 120 | #---------------------------------------------------------------------------- 121 | 122 | preprocess: dirs 123 | @echo "$(SCRIPARCH) preprocess SCRIP source" 124 | @make -f $(SCRIPDIR)/build/preprocess.mk 125 | 126 | #---------------------------------------------------------------------------- 127 | # 128 | # Create the directory structure if it does not exist. 129 | # 130 | #---------------------------------------------------------------------------- 131 | 132 | dirs: 133 | @echo "$(SCRIPARCH) is creating the required directory structure" 134 | @cd $(SCRIPEXEDIR) && if [ ! -d compile ]; then mkdir compile; fi 135 | @cd $(SCRIPEXEDIR)/compile && \ 136 | if [ ! -d Depends ]; then mkdir Depends; fi 137 | @cd $(SCRIPEXEDIR) 138 | 139 | #---------------------------------------------------------------------------- 140 | # 141 | # Include utilities makefile with rules for clean, clobber, etc. 142 | # 143 | #---------------------------------------------------------------------------- 144 | 145 | clean: 146 | ifeq ($(VARSDEFINED),SCRIPEXEDIRSCRIPDIRSCRIPARCH) 147 | @cd $(SCRIPEXEDIR) && $(RM) core scrip scrip_db 148 | @cd $(SCRIPEXEDIR) && $(RM) compile/Depends/*.* 149 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.f compile/*.f90 compile/*.c 150 | @cd $(SCRIPEXEDIR) && $(RM) compile/*.o compile/*.$(MODSUF) 151 | else 152 | @echo " Please setenv SCRIPEXEDIR SCRIPDIR and SCRIPARCH" 153 | @echo " Only $(VARSDEFINED) have been defined." 154 | endif 155 | 156 | #---------------------------------------------------------------------------- 157 | -------------------------------------------------------------------------------- /SCRIP/build/compile.mk: -------------------------------------------------------------------------------- 1 | # 2 | # File: compile.mk 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This makefile finally performs the compile of the SCRIP code. It is 7 | # called from a driver makefile that has already called makefiles for 8 | # preprocessing and dependency generation. 9 | # 10 | #---------------------------------------------------------------------------- 11 | 12 | SHELL = /bin/sh 13 | 14 | #---------------------------------------------------------------------------- 15 | # 16 | # Define the dependency and include directories. 17 | # 18 | #---------------------------------------------------------------------------- 19 | 20 | DepDir = $(SCRIPEXEDIR)/compile/Depends 21 | 22 | #---------------------------------------------------------------------------- 23 | # 24 | # Set valid suffixes. 25 | # 26 | #---------------------------------------------------------------------------- 27 | 28 | # First clean out current list of suffixes, then define them 29 | .SUFFIXES: 30 | .SUFFIXES: .o .c .f .f90 .d .do 31 | 32 | ifeq ($(OPTIMIZE),yes) 33 | DEPSUF = .do 34 | else 35 | DEPSUF = .d 36 | endif 37 | 38 | #---------------------------------------------------------------------------- 39 | # 40 | # Include architecture-specific flags and options. 41 | # 42 | #---------------------------------------------------------------------------- 43 | 44 | ifneq (,$(SCRIPARCH)) 45 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 46 | export SCRIPARCH 47 | else 48 | bogus: 49 | @echo " Please setenv SCRIPARCH" 50 | endif 51 | 52 | #---------------------------------------------------------------------------- 53 | # 54 | # At this stage in the compile process, everything should be in the 55 | # compile and depend directories. 56 | # 57 | #---------------------------------------------------------------------------- 58 | 59 | SRCDIRS = $(SCRIPEXEDIR)/compile/ $(DepDir)/ 60 | VPATH = $(SRCDIRS) 61 | 62 | #---------------------------------------------------------------------------- 63 | # 64 | # Define source, object and dependency files. 65 | # 66 | #---------------------------------------------------------------------------- 67 | 68 | OBJS = 69 | DEPENDS = 70 | 71 | FSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f))) 72 | ifneq (,$(FSRCS)) 73 | OBJS := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(FSRCS:.f=.o))) $(OBJS) 74 | DEPENDS := $(addprefix $(DepDir)/, $(notdir $(FSRCS:.f=$(DEPSUF)))) $(DEPENDS) 75 | endif 76 | 77 | F90SRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f90))) 78 | ifneq (,$(F90SRCS)) 79 | OBJS := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(F90SRCS:.f90=.o))) $(OBJS) 80 | DEPENDS := $(addprefix $(DepDir)/, $(notdir $(F90SRCS:.f90=$(DEPSUF)))) $(DEPENDS) 81 | endif 82 | 83 | CSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.c))) 84 | ifneq (,$(CSRCS)) 85 | OBJS := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(CSRCS:.c=.o))) $(OBJS) 86 | DEPENDS := $(addprefix $(DepDir)/, $(notdir $(CSRCS:.c=$(DEPSUF)))) $(DEPENDS) 87 | endif 88 | 89 | #---------------------------------------------------------------------------- 90 | # 91 | # Make the executable. 92 | # 93 | #---------------------------------------------------------------------------- 94 | 95 | $(SCRIPEXEDIR)/$(TARGETX): $(OBJS) 96 | @echo " GNUmakefile is making target '$(TARGETX)'" 97 | @$(LD) -o $(TARGETX) $(LDFLAGS) $(OBJS) $(LDLIBS) 98 | 99 | #---------------------------------------------------------------------------- 100 | # 101 | # Include all the dependency files 102 | # 103 | #---------------------------------------------------------------------------- 104 | 105 | # Sort to remove duplicates 106 | DEPENDS := $(sort $(DEPENDS)) 107 | 108 | include $(DEPENDS) 109 | 110 | #---------------------------------------------------------------------------- 111 | # 112 | # Implicit rules for compilation 113 | # 114 | #---------------------------------------------------------------------------- 115 | 116 | # Cancel the implicit make rules for compiling 117 | %.o : %.f 118 | %.o : %.f90 119 | %.o : %.c 120 | 121 | %.o: %.f 122 | @echo $(SCRIPARCH) Compiling with implicit rule $< 123 | @cd $(SCRIPEXEDIR)/compile && $(F77) $(FFLAGS) -c $(notdir $<) 124 | 125 | %.o: %.f90 126 | @echo $(SCRIPARCH) Compiling with implicit rule $< 127 | @cd $(SCRIPEXEDIR)/compile && $(F90) $(FFLAGS) -c $(notdir $<) 128 | 129 | %.o: %.c 130 | @echo $(SCRIPARCH) Compiling with implicit rule $< 131 | @cd $(SCRIPEXEDIR)/compile && $(CC) $(Cpp_opts) $(CFLAGS) -c $(notdir $<) 132 | 133 | -------------------------------------------------------------------------------- /SCRIP/build/depends.mk: -------------------------------------------------------------------------------- 1 | # 2 | # File: depends.mk 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This makefile performs the automatic dependency analysis and setup for 7 | # the main SCRIP compile system. It builds a series of dependency files 8 | # for each source file to be compiled. It is called from the main SCRIP 9 | # makefile. 10 | # 11 | #---------------------------------------------------------------------------- 12 | 13 | SHELL = /bin/sh 14 | 15 | #---------------------------------------------------------------------------- 16 | # 17 | # Define the dependency and include directories. 18 | # 19 | #---------------------------------------------------------------------------- 20 | 21 | DepDir = $(SCRIPEXEDIR)/compile/Depends 22 | 23 | #---------------------------------------------------------------------------- 24 | # 25 | # Set valid suffixes. 26 | # 27 | #---------------------------------------------------------------------------- 28 | 29 | # First clean out current list of suffixes, then define them 30 | .SUFFIXES: 31 | .SUFFIXES: .f .f90 .c d .do 32 | 33 | ifeq ($(OPTIMIZE),yes) 34 | DEPSUF = .do 35 | else 36 | DEPSUF = .d 37 | endif 38 | 39 | #---------------------------------------------------------------------------- 40 | # 41 | # Include architecture-specific flags and options. 42 | # 43 | #---------------------------------------------------------------------------- 44 | 45 | ifneq (,$(SCRIPARCH)) 46 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 47 | export SCRIPARCH 48 | else 49 | bogus: 50 | @echo " Please setenv SCRIPARCH" 51 | endif 52 | 53 | #---------------------------------------------------------------------------- 54 | # 55 | # All files should have been preprocessed and placed in the compile 56 | # directory, so only check there for sources and use that for VPATH 57 | # 58 | #---------------------------------------------------------------------------- 59 | 60 | SRCDIRS = $(SCRIPEXEDIR)/compile/ 61 | VPATH = $(SRCDIRS) 62 | 63 | #---------------------------------------------------------------------------- 64 | # 65 | # Create list of source files from which to generate dependencies. 66 | # Create similar list of dependency file targets. 67 | # 68 | #---------------------------------------------------------------------------- 69 | 70 | DEPFILES = 71 | 72 | FSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f))) 73 | ifneq (,$(FSRCS)) 74 | DEPFILES := $(addprefix $(DepDir)/, $(notdir $(FSRCS:.f=$(DEPSUF)))) \ 75 | $(DEPFILES) 76 | endif 77 | 78 | F90SRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f90))) 79 | ifneq (,$(F90SRCS)) 80 | DEPFILES := $(addprefix $(DepDir)/, $(notdir $(F90SRCS:.f90=$(DEPSUF)))) \ 81 | $(DEPFILES) 82 | endif 83 | 84 | CSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.c))) 85 | ifneq (,$(CSRCS)) 86 | DEPFILES := $(addprefix $(DepDir)/, $(notdir $(CSRCS:.c=$(DEPSUF)))) \ 87 | $(DEPFILES) 88 | endif 89 | 90 | #---------------------------------------------------------------------------- 91 | # 92 | # Generate the dependencies - implicit rules handle all cases. 93 | # 94 | #---------------------------------------------------------------------------- 95 | 96 | .PHONY: depends 97 | 98 | depends: $(DEPFILES) 99 | 100 | #---------------------------------------------------------------------------- 101 | # 102 | # Implicit rules for dependency generation. 103 | # 104 | #---------------------------------------------------------------------------- 105 | 106 | $(DepDir)/%$(DEPSUF): $(SRCDIRS)%.f90 107 | @echo '$(SCRIPARCH) Making depends for compiling' $< 108 | @$(AWK) -f $(SCRIPDIR)/build/fdepends.awk -v NAME=$(basename $<) -v SUF=$(suffix $<) -v COMPDIR=$(SCRIPEXEDIR)/compile $< > $(DepDir)/$(@F) 109 | 110 | $(DepDir)/%$(DEPSUF): $(SRCDIRS)%.f 111 | @echo '$(SCRIPARCH) Making depends for compiling' $< 112 | @$(AWK) -f $(SCRIPDIR)/build/fdepends.awk -v NAME=$(basename $<) -v SUF=$(suffix $<) -v COMPDIR=$(SCRIPEXEDIR)/compile $< > $(DepDir)/$(@F) 113 | 114 | # Compiling dependencies are also generated for all .c files, but 115 | # locally included .h files are not treated. None exist at this 116 | # time. The two .c files include only system .h files with names 117 | # delimited by angle brackets, "<...>"; these are not, and should 118 | # not, be analyzed. If the c programming associated with this code 119 | # gets complicated enough to warrant it, the file "cdepends.awk" 120 | # will need to test for includes delimited by quotes. 121 | 122 | $(DepDir)/%$(DEPSUF): $(SRCDIRS)%.c 123 | @echo '$(SCRIPARCH) Making depends for compiling' $< 124 | @echo '$(*).o $(DepDir)/$(*)$(DEPSUF): $(basename $<)$(suffix $<)' > $(DepDir)/$(@F) 125 | 126 | -------------------------------------------------------------------------------- /SCRIP/build/fdepends.awk: -------------------------------------------------------------------------------- 1 | # 2 | # File fdepends.awk 3 | # 4 | # NOTE - this script been stripped down to take care of 5 | # F90 modules only 6 | # 7 | # This script does makefiles for individual object targets. However, 8 | # it only includes dependencies for F90 modules 9 | # 10 | # It initializes itself by defining the target half of each 11 | # dependency line, then printing a special first dependency 12 | # line containing target's object file, subroutine name, makefile 13 | # name, a colon, and the source file on which the others are 14 | # dependent. 15 | # 16 | # Example of first dependency line: 17 | # POP.o ObjDepends/POP.do: POP.f 18 | # 19 | # Example of other dependency line: 20 | # POP.o: io.o 21 | # 22 | # Predefined variables Typical values 23 | # NAME POP 24 | # SUF .f 25 | # COMPDIR ./compile 26 | # 27 | BEGIN { PRLINE = NAME".o: " 28 | print NAME".o: " NAME SUF } 29 | 30 | # 31 | # awk reads each line of the filename argument $2 until it finds 32 | # the pattern "use". 33 | # 34 | 35 | /use/ { # if "use" is not the first token on the line, skip it 36 | if ( $1 != "use" ) next 37 | 38 | # Otherwise, assume the second field is the F90 module name, 39 | # remove any comma at the end of the second field (due to 40 | # ONLY or rename), and print it in a dependency line. 41 | # exclude system-installed modules (eg netcdf) from dependencies 42 | sub(/,/,"",$2) 43 | if ( $2 != "netcdf" && $2 != "mpi" && $2 != "omp_lib") print PRLINE COMPDIR "/" $2".o" 44 | } 45 | -------------------------------------------------------------------------------- /SCRIP/build/linuxabsoft_serial.gnu: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # 3 | # File: linuxabsoft_serial.gnu 4 | # 5 | # Contains compiler and loader options for the Linux OS using the 6 | # Absoft compiler and specifies the serial directory for communications 7 | # modules. Use F77 for fortran fixed-form, F90 for free form. 8 | # 9 | #----------------------------------------------------------------------- 10 | 11 | F77 = f77 12 | F90 = f95 13 | LD = f95 14 | CC = cc 15 | Cp = /bin/cp 16 | Cpp = /usr/bin/cpp -P 17 | AWK = /sw/bin/gawk 18 | ABI = 19 | COMMDIR = serial 20 | 21 | # Enable MPI library for parallel code, yes/no. 22 | 23 | MPI = no 24 | 25 | # Adjust these to point to where netcdf is installed 26 | 27 | #NETCDFINC = -I/netcdf_include_path 28 | #NETCDFLIB = -L/netcdf_library_path 29 | NETCDFINC = -p/sw/include 30 | NETCDFLIB = -L/sw/lib 31 | 32 | # Enable trapping and traceback of floating point exceptions, yes/no. 33 | # Note - Requires 'setenv TRAP_FPE "ALL=ABORT,TRACE"' for traceback. 34 | 35 | TRAP_FPE = no 36 | 37 | #------------------------------------------------------------------ 38 | # precompiler options 39 | #------------------------------------------------------------------ 40 | 41 | Cpp_opts = 42 | 43 | #---------------------------------------------------------------------------- 44 | # 45 | # C Flags 46 | # 47 | #---------------------------------------------------------------------------- 48 | 49 | CFLAGS = $(ABI) 50 | 51 | ifeq ($(OPTIMIZE),yes) 52 | CFLAGS := $(CFLAGS) -O -openmp 53 | else 54 | CFLAGS := $(CFLAGS) -g -openmp 55 | endif 56 | 57 | #---------------------------------------------------------------------------- 58 | # 59 | # FORTRAN Flags 60 | # 61 | #---------------------------------------------------------------------------- 62 | 63 | FBASE = $(ABI) $(NETCDFINC) -p$(DepDir) 64 | MODSUF = mod 65 | 66 | ifeq ($(TRAP_FPE),yes) 67 | FBASE := $(FBASE) 68 | endif 69 | 70 | ifeq ($(OPTIMIZE),yes) 71 | FFLAGS = $(FBASE) -O3 -openmp 72 | else 73 | #FFLAGS := $(FBASE) -g -B80 -Rb -Rc -Rs -trap=ALL 74 | #FFLAGS := $(FBASE) -g -Rb -Rc -Rs -B80 -trap=DIVBYZERO,INVALID 75 | #FFLAGS := $(FBASE) -g -Rc -Rs -trap=DIVBYZERO,INVALID 76 | FFLAGS = $(FBASE) -g -openmp 77 | endif 78 | 79 | #---------------------------------------------------------------------------- 80 | # 81 | # Loader Flags and Libraries 82 | # 83 | #---------------------------------------------------------------------------- 84 | 85 | ifeq ($(OPTIMIZE),yes) 86 | LDFLAGS = $(ABI) -openmp 87 | else 88 | LDFLAGS = $(ABI) -debug:full -debug:cv -openmp 89 | endif 90 | 91 | LIBS = $(NETCDFLIB) -lnetcdf 92 | 93 | ifeq ($(MPI),yes) 94 | LIBS := $(LIBS) -lmpi 95 | endif 96 | 97 | ifeq ($(TRAP_FPE),yes) 98 | LIBS := $(LIBS) 99 | endif 100 | 101 | #LDLIBS = $(TARGETLIB) $(LIBRARIES) $(LIBS) 102 | LDLIBS = $(LIBS) 103 | 104 | -------------------------------------------------------------------------------- /SCRIP/build/linuxg95_serial.gnu: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # 3 | # File: linuxg95_serial.gnu 4 | # 5 | # Contains compiler and loader options for the Linux OS using the 6 | # open source g95 compiler and specifies the serial directory for 7 | # communications modules. 8 | # 9 | #----------------------------------------------------------------------- 10 | 11 | F77 = g95 12 | F90 = g95 13 | LD = g95 14 | CC = cc 15 | Cp = /bin/cp 16 | Cpp = /lib/cpp -P 17 | AWK = /usr/bin/gawk 18 | ABI = 19 | COMMDIR = serial 20 | 21 | # Enable MPI library for parallel code, yes/no. 22 | 23 | MPI = no 24 | 25 | # Adjust these to point to where netcdf is installed 26 | 27 | #NETCDFINC = -I/netcdf_include_path 28 | #NETCDFLIB = -L/netcdf_library_path 29 | #NETCDFINC = -I/usr/local/include 30 | #NETCDFLIB = -L/usr/local/lib 31 | NETCDFINC = -I/home/pwjones/netcdf-3.6.1/include 32 | NETCDFLIB = -L/home/pwjones/netcdf-3.6.1/lib 33 | 34 | # Enable trapping and traceback of floating point exceptions, yes/no. 35 | # Note - Requires 'setenv TRAP_FPE "ALL=ABORT,TRACE"' for traceback. 36 | 37 | TRAP_FPE = no 38 | 39 | #------------------------------------------------------------------ 40 | # precompiler options 41 | #------------------------------------------------------------------ 42 | 43 | #DCOUPL = -Dcoupled 44 | 45 | Cpp_opts = \ 46 | $(DCOUPL) 47 | 48 | Cpp_opts := $(Cpp_opts) -DPOSIX 49 | 50 | #---------------------------------------------------------------------------- 51 | # 52 | # C Flags 53 | # 54 | #---------------------------------------------------------------------------- 55 | 56 | CFLAGS = $(ABI) 57 | 58 | ifeq ($(OPTIMIZE),yes) 59 | CFLAGS := $(CFLAGS) -O -fopenmp 60 | else 61 | CFLAGS := $(CFLAGS) -g -fopenmp 62 | endif 63 | 64 | #---------------------------------------------------------------------------- 65 | # 66 | # FORTRAN Flags 67 | # 68 | #---------------------------------------------------------------------------- 69 | 70 | FBASE = $(ABI) $(NETCDFINC) -I$(DepDir) 71 | MODSUF = mod 72 | 73 | ifeq ($(TRAP_FPE),yes) 74 | FBASE := $(FBASE) 75 | endif 76 | 77 | ifeq ($(OPTIMIZE),yes) 78 | FFLAGS = $(FBASE) -O3 -fopenmp 79 | else 80 | FFLAGS = $(FBASE) -g -fopenmp 81 | endif 82 | 83 | #---------------------------------------------------------------------------- 84 | # 85 | # Loader Flags and Libraries 86 | # 87 | #---------------------------------------------------------------------------- 88 | 89 | LDFLAGS = $(ABI) -fopenmp 90 | 91 | LIBS = $(NETCDFLIB) -lnetcdf -lf95 92 | 93 | ifeq ($(MPI),yes) 94 | LIBS := $(LIBS) -lmpi 95 | endif 96 | 97 | ifeq ($(TRAP_FPE),yes) 98 | LIBS := $(LIBS) 99 | endif 100 | 101 | #LDLIBS = $(TARGETLIB) $(LIBRARIES) $(LIBS) 102 | LDLIBS = $(LIBS) 103 | 104 | -------------------------------------------------------------------------------- /SCRIP/build/linuxgfortran_serial.gnu: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # 3 | # File: linuxgfortran.gnu 4 | # 5 | # Contains compiler and loader options for the Linux OS using the 6 | # gfortran compiler that comes with gcc and specifies the serial directory 7 | # for communications modules. 8 | # 9 | #----------------------------------------------------------------------- 10 | 11 | F77 = gfortran 12 | F90 = gfortran 13 | LD = gfortran 14 | CC = gcc 15 | Cp = /bin/cp 16 | Cpp = /lib/cpp -P 17 | AWK = /usr/bin/gawk 18 | ABI = 19 | COMMDIR = serial 20 | 21 | # Enable MPI library for parallel code, yes/no. 22 | 23 | MPI = no 24 | 25 | # Adjust these to point to where netcdf is installed 26 | 27 | NETCDFINC = -I/netcdf_include_path 28 | NETCDFLIB = -L/netcdf_library_path 29 | #NETCDFINC = -I$(HOME)/packages/netcdf-3.6.3-i686_linux/include 30 | #NETCDFLIB = -L$(HOME)/packages/netcdf-3.6.3-i686_linux/lib 31 | NETCDFINC = -I$(HOME)/packages/netcdf-4.0.1/include 32 | NETCDFLIB = -L$(HOME)/packages/netcdf-4.0.1/lib 33 | 34 | # Enable trapping and traceback of floating point exceptions, yes/no. 35 | # Note - Requires 'setenv TRAP_FPE "ALL=ABORT,TRACE"' for traceback. 36 | 37 | TRAP_FPE = no 38 | 39 | #------------------------------------------------------------------ 40 | # precompiler options 41 | #------------------------------------------------------------------ 42 | 43 | #DCOUPL = -Dcoupled 44 | 45 | Cpp_opts = \ 46 | $(DCOUPL) 47 | 48 | Cpp_opts := $(Cpp_opts) -DPOSIX 49 | 50 | #---------------------------------------------------------------------------- 51 | # 52 | # C Flags 53 | # 54 | #---------------------------------------------------------------------------- 55 | 56 | CFLAGS = $(ABI) 57 | 58 | ifeq ($(OPTIMIZE),yes) 59 | CFLAGS := $(CFLAGS) -O -fopenmp 60 | else 61 | CFLAGS := $(CFLAGS) -g -fopenmp 62 | endif 63 | 64 | #---------------------------------------------------------------------------- 65 | # 66 | # FORTRAN Flags 67 | # 68 | #---------------------------------------------------------------------------- 69 | 70 | FBASE = $(ABI) $(NETCDFINC) -I$(DepDir) 71 | MODSUF = mod 72 | 73 | ifeq ($(TRAP_FPE),yes) 74 | FBASE := $(FBASE) 75 | endif 76 | 77 | ifeq ($(OPTIMIZE),yes) 78 | FFLAGS = $(FBASE) -O3 -fopenmp 79 | else 80 | FFLAGS = $(FBASE) -g -fopenmp 81 | endif 82 | 83 | #---------------------------------------------------------------------------- 84 | # 85 | # Loader Flags and Libraries 86 | # 87 | #---------------------------------------------------------------------------- 88 | 89 | LDFLAGS = $(ABI) -fopenmp 90 | 91 | # for netcdf installations which do not have --enable-netcdf4 92 | 93 | # LIBS = $(NETCDFLIB) -lnetcdf 94 | 95 | # if netcdf is configured with --enable-netcdf4 then it also has to 96 | # be configured with --enable-separate-fortran enabling it to create 97 | # the libnetcdff.a libs 98 | 99 | LIBS = $(NETCDFLIB) -lnetcdf32 -lnetcdff -lhdf5_hl -lhdf5 -lz 100 | 101 | 102 | ifeq ($(MPI),yes) 103 | LIBS := $(LIBS) -lmpi 104 | endif 105 | 106 | ifeq ($(TRAP_FPE),yes) 107 | LIBS := $(LIBS) 108 | endif 109 | 110 | #LDLIBS = $(TARGETLIB) $(LIBRARIES) $(LIBS) 111 | LDLIBS = $(LIBS) 112 | 113 | -------------------------------------------------------------------------------- /SCRIP/build/linuxintel_serial.gnu: -------------------------------------------------------------------------------- 1 | #----------------------------------------------------------------------- 2 | # 3 | # File: linuxintel_serial.gnu 4 | # 5 | # Contains compiler and loader options for linux machines using the 6 | # intel compiler and specifies the serial directory for communications 7 | # modules. 8 | # 9 | #----------------------------------------------------------------------- 10 | F77 = ifort 11 | F90 = ifort 12 | LD = ifort 13 | CC = cc 14 | Cp = /bin/cp 15 | Cpp = cpp -P -C 16 | AWK = /usr/bin/gawk 17 | ABI = 18 | COMMDIR = serial 19 | 20 | # Enable MPI library for parallel code, yes/no. 21 | 22 | MPI = no 23 | 24 | # Adjust these to point to where netcdf is installed 25 | 26 | # These have been loaded as a module so no values necessary 27 | #NETCDFINC = -I/netcdf_include_path 28 | #NETCDFLIB = -L/netcdf_library_path 29 | #NETCDFINC = -I/usr/projects/climate/maltrud/local/include_coyote 30 | #NETCDFLIB = -L/usr/projects/climate/maltrud/local/lib_coyote 31 | NETCDFINC = -I/usr/projects/climate/bzhao/netcdf-3.6.1/include 32 | NETCDFLIB = -L/usr/projects/climate/bzhao/netcdf-3.6.1/lib 33 | 34 | # Enable trapping and traceback of floating point exceptions, yes/no. 35 | # Note - Requires 'setenv TRAP_FPE "ALL=ABORT,TRACE"' for traceback. 36 | 37 | TRAP_FPE = no 38 | 39 | #------------------------------------------------------------------ 40 | # precompiler options 41 | #------------------------------------------------------------------ 42 | 43 | Cpp_opts = -DPOSIX 44 | 45 | #---------------------------------------------------------------------------- 46 | # 47 | # C Flags 48 | # 49 | #---------------------------------------------------------------------------- 50 | 51 | CFLAGS = $(ABI) 52 | 53 | ifeq ($(OPTIMIZE),yes) 54 | CFLAGS := $(CFLAGS) -O -fopenmp 55 | else 56 | CFLAGS := $(CFLAGS) -g -check all -ftrapuv -fopenmp 57 | endif 58 | 59 | #---------------------------------------------------------------------------- 60 | # 61 | # FORTRAN Flags 62 | # 63 | #---------------------------------------------------------------------------- 64 | 65 | FBASE = $(ABI) $(NETCDFINC) $(MPI_COMPILE_FLAGS) -I$(DepDir) -mcmodel=medium -i-dynamic -convert big_endian 66 | MODSUF = mod 67 | 68 | ifeq ($(TRAP_FPE),yes) 69 | FBASE := $(FBASE) 70 | endif 71 | 72 | ifeq ($(OPTIMIZE),yes) 73 | FFLAGS = $(FBASE) -O3 -fopenmp 74 | else 75 | FFLAGS = $(FBASE) -g -check bounds -fopenmp 76 | endif 77 | 78 | #---------------------------------------------------------------------------- 79 | # 80 | # Loader Flags and Libraries 81 | # 82 | #---------------------------------------------------------------------------- 83 | 84 | LDFLAGS = $(ABI) -mcmodel=medium -i-dynamic -convert big_endian -fopenmp 85 | 86 | LIBS = $(NETCDFLIB) -lnetcdf 87 | 88 | ifeq ($(MPI),yes) 89 | LIBS := $(LIBS) $(MPI_LD_FLAGS) -lmpi 90 | endif 91 | 92 | ifeq ($(TRAP_FPE),yes) 93 | LIBS := $(LIBS) 94 | endif 95 | 96 | LDLIBS = $(LIBS) 97 | 98 | #---------------------------------------------------------------------------- 99 | -------------------------------------------------------------------------------- /SCRIP/build/preprocess.mk: -------------------------------------------------------------------------------- 1 | # 2 | # File: preprocess.mk 3 | # 4 | #---------------------------------------------------------------------------- 5 | # 6 | # This makefile is called from the SCRIP driver makefile and performs 7 | # only the preprocessing step. 8 | # 9 | #---------------------------------------------------------------------------- 10 | 11 | SHELL = /bin/sh 12 | 13 | #---------------------------------------------------------------------------- 14 | # 15 | # Set valid suffixes. 16 | # 17 | #---------------------------------------------------------------------------- 18 | 19 | # First clean out current list of suffixes, then define them 20 | .SUFFIXES: 21 | .SUFFIXES: .c .f .f90 .F .F90 .C 22 | 23 | #---------------------------------------------------------------------------- 24 | # 25 | # Include architecture-specific flags and options. 26 | # 27 | #---------------------------------------------------------------------------- 28 | 29 | ifneq (,$(SCRIPARCH)) 30 | include $(SCRIPDIR)/build/$(SCRIPARCH).gnu 31 | export SCRIPARCH 32 | else 33 | bogus: 34 | @echo " Please set SCRIPARCH environment variable" 35 | endif 36 | 37 | #---------------------------------------------------------------------------- 38 | # 39 | # Define paths to sources in variable SRCDIRS. 40 | # 41 | #---------------------------------------------------------------------------- 42 | 43 | SRCDIRS = $(SCRIPEXEDIR)/ 44 | SRCDIRS := $(SRCDIRS) $(SCRIPDIR)/source/ 45 | SRCDIRS := $(SRCDIRS) $(SCRIPDIR)/source/$(COMMDIR)/ 46 | 47 | #---------------------------------------------------------------------------- 48 | # 49 | # VPATH is the built-in symbol whose value is the path that make will 50 | # search for dependencies. 51 | # 52 | #---------------------------------------------------------------------------- 53 | 54 | VPATH = $(SRCDIRS) 55 | 56 | #---------------------------------------------------------------------------- 57 | # 58 | # Define .F sources that must be preprocessed into the build directory as .f 59 | # and add .f version to list of target source files. 60 | # 61 | #---------------------------------------------------------------------------- 62 | 63 | SOURCES = 64 | FSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.F))) 65 | ifneq (,$(FSRCS)) 66 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(FSRCS:.F=.f))) \ 67 | $(SOURCES) 68 | endif 69 | 70 | #---------------------------------------------------------------------------- 71 | # 72 | # Define .F90 sources to be preprocessed into the build directory as .f90 73 | # 74 | #---------------------------------------------------------------------------- 75 | 76 | F90SRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.F90))) 77 | ifneq (,$(F90SRCS)) 78 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(F90SRCS:.F90=.f90))) \ 79 | $(SOURCES) 80 | endif 81 | 82 | #---------------------------------------------------------------------------- 83 | # 84 | # Define .C sources that must be preprocessed into the build directory as .c 85 | # 86 | #---------------------------------------------------------------------------- 87 | 88 | CSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.C))) 89 | ifneq (,$(CSRCS)) 90 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(CSRCS:.C=.c))) \ 91 | $(SOURCES) 92 | endif 93 | 94 | #---------------------------------------------------------------------------- 95 | # 96 | # Define any .f sources that need to be copied into the build directory 97 | # 98 | #---------------------------------------------------------------------------- 99 | 100 | LFSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f))) 101 | ifneq (,$(LFSRCS)) 102 | ifneq (,$(FSRCS)) 103 | LFSRCS := $(filter-out $(FSRCS:.F=.f),$(LFSRCS)) 104 | endif 105 | ifneq (,$(LFSRCS)) 106 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(LFSRCS))) \ 107 | $(SOURCES) 108 | endif 109 | endif 110 | 111 | #---------------------------------------------------------------------------- 112 | # 113 | # Define .f90 sources that need to be copied into the build directory 114 | # 115 | #---------------------------------------------------------------------------- 116 | 117 | LF90SRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.f90))) 118 | ifneq (,$(LF90SRCS)) 119 | ifneq (,$(F90SRCS)) 120 | LF90SRCS := $(filter-out $(F90SRCS:.F90=.f90),$(LF90SRCS)) 121 | endif 122 | ifneq (,$(LF90SRCS)) 123 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(LF90SRCS))) \ 124 | $(SOURCES) 125 | endif 126 | endif 127 | 128 | #---------------------------------------------------------------------------- 129 | # 130 | # Define .c sources that need to be copied into the build directory 131 | # 132 | #---------------------------------------------------------------------------- 133 | 134 | LCSRCS = $(strip $(foreach dir,$(SRCDIRS),$(wildcard $(dir)*.c))) 135 | ifneq (,$(LCSRCS)) 136 | ifneq (,$(CSRCS)) 137 | LCSRCS := $(filter-out $(CSRCS:.C=.c),$(LCSRCS)) 138 | endif 139 | ifneq (,$(LCSRCS)) 140 | SOURCES := $(addprefix $(SCRIPEXEDIR)/compile/, $(notdir $(LCSRCS))) \ 141 | $(SOURCES) 142 | endif 143 | endif 144 | 145 | #---------------------------------------------------------------------------- 146 | # 147 | # Preprocess all source files. Implicit rules should take care of all cases. 148 | # 149 | #---------------------------------------------------------------------------- 150 | 151 | .PHONY: preprocess 152 | 153 | preprocess: $(SOURCES) 154 | 155 | #---------------------------------------------------------------------------- 156 | # 157 | # Implicit rules for preprocessing. 158 | # 159 | #---------------------------------------------------------------------------- 160 | 161 | # Cancel the implicit make rules for preprocessing 162 | 163 | %.c : %.C 164 | %.f90 : %.F90 165 | %.f : %.F 166 | 167 | # Preprocessing rules for Fortran (.F, F90) and C files 168 | 169 | $(SCRIPEXEDIR)/compile/%.f: %.F 170 | @echo '$(SCRIPARCH) preprocessing ' $< 171 | @$(Cpp) $(Cpp_opts) $< > $(SCRIPEXEDIR)/compile/$*.f 172 | 173 | $(SCRIPEXEDIR)/compile/%.f90: %.F90 174 | @echo '$(SCRIPARCH) preprocessing ' $< 175 | @$(Cpp) $(Cpp_opts) $< > $(SCRIPEXEDIR)/compile/$*.f90 176 | 177 | # For some reason, our current Cpp options are incorrect for C files 178 | # so let the C compiler take care of ifdefs and just copy. 179 | 180 | $(SCRIPEXEDIR)/compile/%.c: %.C 181 | @echo '$(SCRIPARCH) preprocessing ' $< 182 | @$(Cp) $< $(SCRIPEXEDIR)/compile/$*.c 183 | 184 | # Preprocessing rules for Fortran f, f90 and c files 185 | # Should only copy these files into the compile directory. 186 | 187 | $(SCRIPEXEDIR)/compile/%.f: %.f 188 | @echo '$(SCRIPARCH) preprocessing ' $< 189 | @$(Cp) $< $(SCRIPEXEDIR)/compile/$*.f 190 | 191 | $(SCRIPEXEDIR)/compile/%.f90: %.f90 192 | @echo '$(SCRIPARCH) preprocessing ' $< 193 | @$(Cp) $< $(SCRIPEXEDIR)/compile/$*.f90 194 | 195 | $(SCRIPEXEDIR)/compile/%.c: %.c 196 | @echo '$(SCRIPARCH) preprocessing ' $< 197 | @$(Cp) $< $(SCRIPEXEDIR)/compile/$*.c 198 | 199 | #---------------------------------------------------------------------------- 200 | -------------------------------------------------------------------------------- /SCRIP/doc/SCRIPusers.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SCRIP-Project/SCRIP/a5d6960ac96269d5c3adbd620ef024c94d32b488/SCRIP/doc/SCRIPusers.pdf -------------------------------------------------------------------------------- /SCRIP/drivers/SCRIP_driver.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | program SCRIP_driver 4 | 5 | !BOP 6 | ! !PROGRAM: SCRIP_driver 7 | ! 8 | ! !DESCRIPTION: 9 | ! This program is a standalone driver for computing SCRIP weights 10 | ! that are written to a file for later use. It reads in inputs 11 | ! and then calls the appropriate SCRIP routines for the desired 12 | ! weights. The program reads options from a file named 13 | ! {\em scrip\_in} with a single namelist-like group in the format 14 | ! below and the inputs shown: 15 | ! \begin{verbatim} 16 | ! &remapInputs 17 | ! gridFile1 = 'filename' (input file for first grid) 18 | ! gridFile2 = 'filename' (input file for second grid) 19 | ! interpFile1 = 'filename' (output file for grid1->grid2 map) 20 | ! interpFile2 = 'filename' (output file for grid2->grid1 map) 21 | ! mapName1 = 'name' (name for grid1->grid2 map) 22 | ! mapName2 = 'name' (name for grid2->grid1 map) 23 | ! num_maps = 1 or 2 (1 for a single grid1->grid2 map, 24 | ! 2 for computing map for both directions) 25 | ! luse_grid1_area = .true./.false. (true to use input grid area 26 | ! luse_grid2_area = .true./.false. in place of SCRIP-computed area) 27 | ! mapMethod = 'method' (regrid method: conservative, bilinear, 28 | ! bicubic or nearNbr) 29 | ! normalizeOpt = 'option' (option for weight normalization: 30 | ! dstArea, fracArea) 31 | ! outputFormat = 'format' (output format - scrip or ccsm) 32 | ! restrict_type = 'type' (choice for restricting grid searches: 33 | ! latitude, longitude, latlon) 34 | ! num_srch_bins = [1-n] (integer number of search bins to divide 35 | ! domain and speed grid searches) 36 | ! num_polar_segs = 11 (Number of segments each lat-lon line must be 37 | ! subdivided into to get an accurate representation 38 | ! of the equivalent curve in polar space 39 | ! npole_threshold = 1.5 (Latitude above which line segments are transformed 40 | ! to Lambert Space in the northern hemisphere) 41 | ! spole_threshold = -1.5 (Latitude below with line segments are transformed 42 | ! to Lambert space in the southern hemisphere 43 | ! num_threads = 2 (Number of simultaneous threads to run program with) 44 | ! / 45 | ! \end{verbatim} 46 | ! 47 | ! !REVISION HISTORY: 48 | ! SVN:$Id: $ 49 | 50 | ! !USES: 51 | 52 | use SCRIP_KindsMod ! module defining data types 53 | use SCRIP_CommMod ! for initializing comm environment 54 | use SCRIP_ErrorMod ! SCRIP error checking and logging 55 | use SCRIP_IOUnitsMod ! manages I/O units 56 | use SCRIP_ConfigMod ! SCRIP configuration module 57 | use SCRIP_InitMod ! SCRIP initialization 58 | use constants ! module for common constants 59 | use timers ! CPU timers 60 | use grids ! module with grid information 61 | use remap_vars ! common remapping variables 62 | use remap_conservative ! routines for conservative remap 63 | use remap_distance_weight ! routines for dist-weight remap 64 | use remap_bilinear ! routines for bilinear interp 65 | use remap_bicubic ! routines for bicubic interp 66 | use SCRIP_RemapParticleMod ! routines for particle remap 67 | use remap_write ! routines for remap output 68 | 69 | implicit none 70 | 71 | !EOP 72 | !BOC 73 | !----------------------------------------------------------------------- 74 | ! 75 | ! local variables 76 | ! 77 | !----------------------------------------------------------------------- 78 | 79 | integer (SCRIP_i4) :: & 80 | errorCode ! error flag 81 | 82 | character (SCRIP_charLength) :: & 83 | gridFile1, &! filename of grid file containing grid1 84 | gridFile2, &! filename of grid file containing grid2 85 | interpFile1, &! filename for output remap data (map1) 86 | interpFile2, &! filename for output remap data (map2) 87 | mapName1, &! name for mapping from grid1 to grid2 88 | mapName2, &! name for mapping from grid2 to grid1 89 | mapMethod, &! choice for mapping method 90 | normalizeOpt, &! option for normalizing weights 91 | outputFormat ! option for output conventions 92 | 93 | character (12), parameter :: & 94 | rtnName = 'SCRIP_driver' 95 | 96 | !----------------------------------------------------------------------- 97 | ! 98 | ! local variables 99 | ! 100 | !----------------------------------------------------------------------- 101 | 102 | integer (SCRIP_i4) :: & 103 | n, &! dummy counter 104 | iunit ! unit number for input configuration file 105 | 106 | !----------------------------------------------------------------------- 107 | ! 108 | ! initialize communication environment and SCRIP package 109 | ! 110 | !----------------------------------------------------------------------- 111 | 112 | errorCode = SCRIP_Success 113 | 114 | call SCRIP_CommInitMessageEnvironment 115 | call SCRIP_Initialize(errorCode) 116 | if (SCRIP_errorCheck(errorCode, rtnName, 'error initializing SCRIP')) & 117 | call SCRIP_driverExit(errorCode) 118 | 119 | !----------------------------------------------------------------------- 120 | ! 121 | ! initialize timers 122 | ! 123 | !----------------------------------------------------------------------- 124 | 125 | call timers_init 126 | do n=1,max_timers 127 | call timer_clear(n) 128 | end do 129 | 130 | !----------------------------------------------------------------------- 131 | ! 132 | ! read input namelist 133 | ! 134 | !----------------------------------------------------------------------- 135 | 136 | call SCRIP_ConfigOpen(iunit, errorCode) 137 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 138 | 'error opening config file')) call SCRIP_driverExit(errorCode) 139 | 140 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 141 | 'gridFile1', gridFile1, 'unknown', errorCode, & 142 | outStringBefore= 'grid1 contained in file: ') 143 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 144 | 'error reading grid1 filename')) call SCRIP_driverExit(errorCode) 145 | 146 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 147 | 'gridFile2', gridFile2, 'unknown', errorCode, & 148 | outStringBefore= 'grid2 contained in file: ') 149 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 150 | 'error reading grid2 filename')) call SCRIP_driverExit(errorCode) 151 | 152 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'interpFile1', & 153 | interpFile1, 'unknown', errorCode, & 154 | outStringBefore= 'grid1 to grid2 regrid contained in file: ') 155 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 156 | 'error reading interp1 filename')) call SCRIP_driverExit(errorCode) 157 | 158 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'interpFile2', & 159 | interpFile2, 'unknown', errorCode, & 160 | outStringBefore= 'grid2 to grid1 regrid contained in file: ') 161 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 162 | 'error reading interp2 filename')) call SCRIP_driverExit(errorCode) 163 | 164 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 165 | 'mapName1', mapName1, 'unknown', errorCode, & 166 | outStringBefore= 'map1 will be named: ') 167 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 168 | 'error reading map1 name')) call SCRIP_driverExit(errorCode) 169 | 170 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 171 | 'mapName2', mapName2, 'unknown', errorCode, & 172 | outStringBefore= 'map2 will be named: ') 173 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 174 | 'error reading map2 name')) call SCRIP_driverExit(errorCode) 175 | 176 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 177 | 'num_maps', num_maps, 1, errorCode, & 178 | outStringBefore= 'Computing ', & 179 | outStringAfter= ' remappings') 180 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 181 | 'error reading num_maps')) call SCRIP_driverExit(errorCode) 182 | 183 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'luse_grid1_area', & 184 | luse_grid1_area, .false., errorCode, & 185 | outStringBefore= 'Use grid1 area: ') 186 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 187 | 'error reading luse_grid1_area')) call SCRIP_driverExit(errorCode) 188 | 189 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'luse_grid2_area', & 190 | luse_grid2_area, .false., errorCode, & 191 | outStringBefore= 'Use grid2 area: ') 192 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 193 | 'error reading luse_grid2_area')) call SCRIP_driverExit(errorCode) 194 | 195 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'mapMethod', & 196 | mapMethod, 'conservative', errorCode, & 197 | outStringBefore= 'Map method is ') 198 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 199 | 'error reading mapMethod')) call SCRIP_driverExit(errorCode) 200 | 201 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'normalizeOpt', & 202 | normalizeOpt, 'fracArea', errorCode, & 203 | outStringBefore= 'Normalization option is: ') 204 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 205 | 'error reading normalizeOpt')) call SCRIP_driverExit(errorCode) 206 | 207 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'outputFormat', & 208 | outputFormat, 'scrip', errorCode, & 209 | outStringBefore= 'Output format is: ') 210 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 211 | 'error reading outputFormat')) call SCRIP_driverExit(errorCode) 212 | 213 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'restrict_type', & 214 | restrict_type, 'latitude', errorCode, & 215 | outStringBefore= 'Restricting search by: ') 216 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 217 | 'error reading restrict_type')) call SCRIP_driverExit(errorCode) 218 | 219 | call SCRIP_ConfigRead(iunit, 'remapInputs', 'num_srch_bins', & 220 | num_srch_bins, 900, errorCode, & 221 | outStringBefore= 'Using ', & 222 | outStringAfter = ' search bins') 223 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 224 | 'error reading num_srch_bins')) call SCRIP_driverExit(errorCode) 225 | 226 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 227 | 'num_polar_segs', npseg, 11, errorCode, & 228 | outStringBefore= 'Using ', & 229 | outStringAfter= ' segments per polar edge') 230 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 231 | 'error reading num_polar_segs')) call SCRIP_driverExit(errorCode) 232 | 233 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 234 | 'npole_threshold', north_thresh, & 235 | 1.5_SCRIP_r8, & 236 | errorCode, & 237 | outStringBefore='North pole threshold is ',& 238 | outStringAfter= ' radians') 239 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 240 | 'error reading npole_threshold')) & 241 | call SCRIP_driverExit(errorCode) 242 | 243 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 244 | 'spole_threshold', south_thresh, & 245 | -2.0_SCRIP_r8, & 246 | errorCode, & 247 | outStringBefore='South pole threshold is ',& 248 | outStringAfter= ' radians') 249 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 250 | 'error reading spole_threshold')) & 251 | call SCRIP_driverExit(errorCode) 252 | 253 | call SCRIP_ConfigRead(iunit, 'remapInputs', & 254 | 'num_threads', nthreads, & 255 | 2, & 256 | errorCode, & 257 | outStringBefore='Number of threads ',& 258 | outStringAfter= '') 259 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 260 | 'error reading number of threads')) & 261 | call SCRIP_driverExit(errorCode) 262 | 263 | 264 | call SCRIP_ConfigClose(iunit, errorCode) 265 | if (SCRIP_ErrorCheck(errorCode, rtnName, & 266 | 'error closing config file')) call SCRIP_driverExit(errorCode) 267 | 268 | select case(mapMethod) 269 | case ('conservative') 270 | map_type = map_type_conserv 271 | luse_grid_centers = .false. 272 | case ('bilinear') 273 | map_type = map_type_bilinear 274 | luse_grid_centers = .true. 275 | case ('bicubic') 276 | map_type = map_type_bicubic 277 | luse_grid_centers = .true. 278 | case ('distwgt') 279 | map_type = map_type_distwgt 280 | luse_grid_centers = .true. 281 | case ('particle') 282 | map_type = map_type_particle 283 | luse_grid_centers = .false. 284 | case default 285 | call SCRIP_ErrorSet(errorCode, rtnName, 'unknown mapping method') 286 | call SCRIP_driverExit(errorCode) 287 | end select 288 | 289 | select case(trim(normalizeOpt)) 290 | case ('none') 291 | norm_opt = norm_opt_none 292 | case ('fracArea') 293 | norm_opt = norm_opt_frcarea 294 | case ('destArea') 295 | norm_opt = norm_opt_dstarea 296 | case default 297 | call SCRIP_ErrorSet(errorCode, rtnName, 'unknown normalization option') 298 | call SCRIP_driverExit(errorCode) 299 | end select 300 | 301 | !----------------------------------------------------------------------- 302 | ! 303 | ! initialize grid information for both grids 304 | ! 305 | !----------------------------------------------------------------------- 306 | 307 | call grid_init(gridFile1, gridFile2, errorCode) 308 | 309 | if (SCRIP_ErrorCheck(errorCode, rtnName, 'Error initializing grids')) & 310 | call SCRIP_driverExit(errorCode) 311 | 312 | write(SCRIP_stdout, *) 'Computing remappings between: ',grid1_name 313 | write(SCRIP_stdout, *) ' and ',grid2_name 314 | 315 | !----------------------------------------------------------------------- 316 | ! 317 | ! initialize some remapping variables. 318 | ! 319 | !----------------------------------------------------------------------- 320 | 321 | call init_remap_vars 322 | 323 | !----------------------------------------------------------------------- 324 | ! 325 | ! call appropriate interpolation setup routine based on type of 326 | ! remapping requested. 327 | ! 328 | !----------------------------------------------------------------------- 329 | 330 | select case(map_type) 331 | case(map_type_conserv) 332 | call remap_conserv 333 | case(map_type_bilinear) 334 | call remap_bilin 335 | case(map_type_distwgt) 336 | call remap_distwgt 337 | case(map_type_bicubic) 338 | call remap_bicub 339 | case(map_type_particle) 340 | call SCRIP_RemapParticleCreate(errorCode) 341 | case default 342 | call SCRIP_ErrorSet(errorCode, rtnName, 'Invalid Map Type') 343 | call SCRIP_driverExit(errorCode) 344 | end select 345 | 346 | !----------------------------------------------------------------------- 347 | ! 348 | ! reduce size of remapping arrays and write remapping info to file. 349 | ! 350 | !----------------------------------------------------------------------- 351 | 352 | if (num_links_map1 /= max_links_map1) then 353 | call resize_remap_vars(1, num_links_map1-max_links_map1) 354 | endif 355 | if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then 356 | call resize_remap_vars(2, num_links_map2-max_links_map2) 357 | endif 358 | 359 | call write_remap(mapName1, mapName2, & 360 | interpFile1, interpFile2, outputFormat, errorCode) 361 | if (SCRIP_ErrorCheck(errorCode, rtnName, 'error in write_remap')) & 362 | call SCRIP_driverExit(errorCode) 363 | 364 | !----------------------------------------------------------------------- 365 | ! 366 | ! All done, exit gracefully 367 | ! 368 | !----------------------------------------------------------------------- 369 | 370 | call SCRIP_driverExit(errorCode) 371 | 372 | !----------------------------------------------------------------------- 373 | !EOC 374 | 375 | end program SCRIP_driver 376 | 377 | !*********************************************************************** 378 | !BOP 379 | ! !IROUTINE: SCRIP_driverExit 380 | ! !INTERFACE: 381 | 382 | subroutine SCRIP_driverExit(errorCode) 383 | 384 | ! !DESCRIPTION: 385 | ! This routine exits the SCRIP driver program. It first calls the 386 | ! SCRIP error print function to print any errors encountered and then 387 | ! exits the message environment before stopping. 388 | ! 389 | ! !REVISION HISTORY: 390 | ! SVN:$Id: $ 391 | 392 | ! !USES: 393 | 394 | use SCRIP_KindsMod 395 | use SCRIP_CommMod 396 | use SCRIP_ErrorMod 397 | 398 | ! !INPUT PARAMETERS: 399 | 400 | integer (SCRIP_i4), intent(in) :: & 401 | errorCode ! error flag to detect any errors encountered 402 | 403 | !EOP 404 | !BOC 405 | !----------------------------------------------------------------------- 406 | ! 407 | ! call SCRIP error print function to output any logged errors that 408 | ! were encountered during execution. Then stop. 409 | ! 410 | !----------------------------------------------------------------------- 411 | 412 | call SCRIP_errorPrint(errorCode, SCRIP_masterTask) 413 | call SCRIP_CommExitMessageEnvironment 414 | 415 | stop 416 | 417 | !----------------------------------------------------------------------- 418 | !EOC 419 | 420 | end subroutine SCRIP_driverExit 421 | 422 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 423 | -------------------------------------------------------------------------------- /SCRIP/grids/CreateLatLon.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | program CreateLatLon 4 | 5 | !BOP 6 | ! !PROGRAM: CreateLatLon 7 | ! 8 | ! !DESCRIPTION: 9 | ! This program creates a global grid with equally-spaced longitude 10 | ! points and Gaussian-spaced latitude points (typical of spherical 11 | ! spectral grids). The resulting grid is written to a file in 12 | ! SCRIP format. 13 | ! 14 | ! !REVISION HISTORY: 15 | ! SVN:$Id: $ 16 | 17 | ! !USES: 18 | 19 | use SCRIP_KindsMod 20 | use SCRIP_IOUnitsMod 21 | use SCRIP_NetcdfMod 22 | use netcdf 23 | 24 | !EOP 25 | !BOC 26 | !----------------------------------------------------------------------- 27 | ! 28 | ! variables that describe the grid 29 | ! 30 | !----------------------------------------------------------------------- 31 | 32 | integer (SCRIP_i4), parameter :: & 33 | nx = 360, ny = 180, &! size in each direction (x is longitude) 34 | gridSize = nx*ny, &! total size of grid 35 | gridRank = 2, &! number of dimensions in grid arrays 36 | numCorners = 4 ! number of corners for each grid cell 37 | 38 | character (SCRIP_charLength), parameter :: & 39 | gridName = 'Lat/lon 1 degree Grid', &! name for this grid 40 | gridFilename = 'll1deg_grid.nc' ! file where grid is written 41 | 42 | integer (SCRIP_i4), dimension(gridRank) :: & 43 | gridDims 44 | 45 | !----------------------------------------------------------------------- 46 | ! 47 | ! grid coordinates and masks 48 | ! 49 | !----------------------------------------------------------------------- 50 | 51 | integer (SCRIP_i4), dimension(gridSize) :: & 52 | gridMask 53 | 54 | real (SCRIP_r8), dimension(gridSize) :: & 55 | centerLat, &! lat/lon coordinates for 56 | centerLon ! each grid center in degrees 57 | 58 | real (SCRIP_r8), dimension(numCorners,gridSize) :: & 59 | cornerLat, &! lat/lon coordinates for 60 | cornerLon ! each grid corner in degrees 61 | 62 | !----------------------------------------------------------------------- 63 | ! 64 | ! other local variables 65 | ! 66 | !----------------------------------------------------------------------- 67 | 68 | integer (SCRIP_i4) :: & 69 | i,j, &! loop indices 70 | errorCode, &! error code for SCRIP error handling 71 | nCell ! cell number in linear storage 72 | 73 | integer (SCRIP_i4) :: & 74 | ncstat, &! general netCDF status variable 75 | ncFileID, &! netCDF grid dataset id 76 | ncGridSizeID, &! netCDF grid size dim id 77 | ncGridCornerID, &! netCDF grid corner dim id 78 | ncGridRankID, &! netCDF grid rank dim id 79 | ncGridDimsID, &! netCDF grid dimension size id 80 | ncCenterLatID, &! netCDF grid center lat id 81 | ncCenterLonID, &! netCDF grid center lon id 82 | ncGridMaskID, &! netCDF grid mask id 83 | ncCornerLatID, &! netCDF grid corner lat id 84 | ncCornerLonID ! netCDF grid corner lon id 85 | 86 | integer (SCRIP_i4), dimension(2) :: & 87 | ncDims2dID ! netCDF dim id array for 2-d arrays 88 | 89 | real (SCRIP_r8) :: & 90 | dLon, dLat, &! grid spacing in lat, lon 91 | minLon, maxLon, &! lon range for each cell 92 | minLat, maxLat, &! lat range for each cell 93 | midLat, midLon ! latitude,longitude of cell center 94 | 95 | character (12), parameter :: & 96 | rtnName = 'CreateLatLon' 97 | 98 | !----------------------------------------------------------------------- 99 | ! 100 | ! compute longitudes and latitudes of cell centers and corners. 101 | ! 102 | !----------------------------------------------------------------------- 103 | 104 | gridDims(1) = nx 105 | gridDims(2) = ny 106 | 107 | dLon = 360.0_SCRIP_r8/nx 108 | dLat = 180.0_SCRIP_r8/ny 109 | 110 | do j=1,ny 111 | 112 | minLat = -90.0_SCRIP_r8 + (j-1)*dLat 113 | maxLat = -90.0_SCRIP_r8 + j *dLat 114 | midLat = minLat + 0.5_SCRIP_r8*dLat 115 | 116 | do i=1,nx 117 | midLon = (i-1)*dLon 118 | minLon = midLon - 0.5_SCRIP_r8*dLon 119 | maxLon = midLon + 0.5_SCRIP_r8*dLon 120 | 121 | nCell = (j-1)*nx + i 122 | 123 | centerLat(nCell ) = midLat 124 | cornerLat(1,nCell) = minLat 125 | cornerLat(2,nCell) = minLat 126 | cornerLat(3,nCell) = maxLat 127 | cornerLat(4,nCell) = maxLat 128 | 129 | centerLon(nCell ) = midLon 130 | cornerLon(1,nCell) = minLon 131 | cornerLon(2,nCell) = maxLon 132 | cornerLon(3,nCell) = maxLon 133 | cornerLon(4,nCell) = minLon 134 | end do 135 | end do 136 | 137 | !----------------------------------------------------------------------- 138 | ! 139 | ! define mask 140 | ! 141 | !----------------------------------------------------------------------- 142 | 143 | gridMask = 1 144 | 145 | !----------------------------------------------------------------------- 146 | ! 147 | ! set up attributes for netCDF file 148 | ! 149 | !----------------------------------------------------------------------- 150 | 151 | !*** 152 | !*** create netCDF dataset for this grid 153 | !*** 154 | 155 | ncstat = nf90_create (trim(gridFilename), NF_CLOBBER, ncFileID) 156 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 157 | 'error opening file')) call CreateLatLonExit(errorCode) 158 | 159 | ncstat = nf90_put_att(ncFileID, NF_GLOBAL, 'title', trim(gridName)) 160 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 161 | 'error writing grid name')) call CreateLatLonExit(errorCode) 162 | 163 | !*** 164 | !*** define grid size dimension 165 | !*** 166 | 167 | ncstat = nf90_def_dim(ncFileID, 'grid_size', gridSize, ncGridSizeID) 168 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 169 | 'error defining grid size')) call CreateLatLonExit(errorCode) 170 | 171 | !*** 172 | !*** define grid corner dimension 173 | !*** 174 | 175 | ncstat = nf90_def_dim(ncFileID, 'grid_corners', numCorners, ncGridCornerID) 176 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 177 | 'error defining num corners')) call CreateLatLonExit(errorCode) 178 | 179 | !*** 180 | !*** define grid rank dimension 181 | !*** 182 | 183 | ncstat = nf90_def_dim(ncFileID, 'grid_rank', gridRank, ncGridRankID) 184 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 185 | 'error defining grid rank')) call CreateLatLonExit(errorCode) 186 | 187 | !*** 188 | !*** define grid dimension size array 189 | !*** 190 | 191 | ncstat = nf90_def_var(ncFileID, 'grid_dims', nf90_int, & 192 | ncGridRankID, ncGridDimsID) 193 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 194 | 'error defining grid dims')) call CreateLatLonExit(errorCode) 195 | 196 | !*** 197 | !*** define grid center latitude array 198 | !*** 199 | 200 | ncstat = nf90_def_var(ncFileID, 'grid_center_lat', nf90_double, & 201 | ncGridSizeID, ncCenterLatID) 202 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 203 | 'error defining grid center lats')) call CreateLatLonExit(errorCode) 204 | 205 | ncstat = nf90_put_att(ncFileID, ncCenterLatID, 'units', 'degrees') 206 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 207 | 'error writing grid units')) call CreateLatLonExit(errorCode) 208 | 209 | !*** 210 | !*** define grid center longitude array 211 | !*** 212 | 213 | ncstat = nf90_def_var(ncFileID, 'grid_center_lon', nf90_double, & 214 | ncGridSizeID, ncCenterLonID) 215 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 216 | 'error defining grid center lons')) call CreateLatLonExit(errorCode) 217 | 218 | ncstat = nf90_put_att(ncFileID, ncCenterLonID, 'units', 'degrees') 219 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 220 | 'error writing grid units')) call CreateLatLonExit(errorCode) 221 | 222 | !*** 223 | !*** define grid mask 224 | !*** 225 | 226 | ncstat = nf90_def_var (ncFileID, 'grid_imask', nf90_int, & 227 | ncGridSizeID, ncGridMaskID) 228 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 229 | 'error defining grid mask')) call CreateLatLonExit(errorCode) 230 | 231 | ncstat = nf90_put_att(ncFileID, ncGridMaskID, 'units', 'unitless') 232 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 233 | 'error writing mask units')) call CreateLatLonExit(errorCode) 234 | 235 | !*** 236 | !*** define grid corner latitude array 237 | !*** 238 | 239 | ncDims2dID(1) = ncGridCornerID 240 | ncDims2dID(2) = ncGridSizeID 241 | 242 | ncstat = nf90_def_var(ncFileID, 'grid_corner_lat', nf90_double, & 243 | ncDims2dID, ncCornerLatID) 244 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 245 | 'error defining corner lats')) call CreateLatLonExit(errorCode) 246 | 247 | ncstat = nf90_put_att(ncFileID, ncCornerLatID, 'units', 'degrees') 248 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 249 | 'error writing corner lat units')) call CreateLatLonExit(errorCode) 250 | 251 | !*** 252 | !*** define grid corner longitude array 253 | !*** 254 | 255 | ncstat = nf90_def_var(ncFileID, 'grid_corner_lon', nf90_double, & 256 | ncDims2dID, ncCornerLonID) 257 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 258 | 'error defining corner lons')) call CreateLatLonExit(errorCode) 259 | 260 | ncstat = nf90_put_att(ncFileID, ncCornerLonID, 'units', 'degrees') 261 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 262 | 'error writing corner lon units')) call CreateLatLonExit(errorCode) 263 | 264 | !*** 265 | !*** end definition stage 266 | !*** 267 | 268 | ncstat = nf90_enddef(ncFileID) 269 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 270 | 'error ending define stage')) call CreateLatLonExit(errorCode) 271 | 272 | !----------------------------------------------------------------------- 273 | ! 274 | ! write grid data 275 | ! 276 | !----------------------------------------------------------------------- 277 | 278 | ncstat = nf90_put_var(ncFileID, ncGridDimsID, gridDims) 279 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 280 | 'error writing grid dims')) call CreateLatLonExit(errorCode) 281 | 282 | ncstat = nf90_put_var(ncFileID, ncGridMaskID, grid_imask) 283 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 284 | 'error writing grid mask')) call CreateLatLonExit(errorCode) 285 | 286 | ncstat = nf90_put_var(ncFileID, ncCenterLatID, centerLat) 287 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 288 | 'error writing center lats')) call CreateLatLonExit(errorCode) 289 | 290 | ncstat = nf90_put_var(ncFileID, ncCenterLonID, centerLon) 291 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 292 | 'error writing center lons')) call CreateLatLonExit(errorCode) 293 | 294 | ncstat = nf90_put_var(ncFileID, ncCornerLatID, cornerLat) 295 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 296 | 'error writing corner lats')) call CreateLatLonExit(errorCode) 297 | 298 | ncstat = nf90_put_var(ncFileID, ncCornerLonID, cornerLon) 299 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 300 | 'error writing corner lons')) call CreateLatLonExit(errorCode) 301 | 302 | ncstat = nf90_close(ncFileID) 303 | if (SCRIP_NetcdfErrorCheck(ncstat, errorCode, rtnName, & 304 | 'error closing file')) call CreateLatLonExit(errorCode) 305 | 306 | !----------------------------------------------------------------------- 307 | !EOC 308 | 309 | end program CreateLatLon 310 | 311 | !*********************************************************************** 312 | !BOP 313 | ! !IROUTINE: CreateLatLonExit 314 | ! !INTERFACE: 315 | 316 | subroutine CreateLatLonExit(errorCode) 317 | 318 | ! !DESCRIPTION: 319 | ! This program exits the CreateLatLon program. It first calls the 320 | ! SCRIP error print function to print any errors encountered and then 321 | ! stops the execution. 322 | ! 323 | ! !REVISION HISTORY: 324 | ! SVN:$Id: $ 325 | 326 | ! !USES: 327 | 328 | use SCRIP_KindsMod 329 | use SCRIP_ErrorMod 330 | 331 | ! !INPUT PARAMETERS: 332 | 333 | integer (SCRIP_i4), intent(in) :: & 334 | errorCode ! error flag to detect any errors encountered 335 | 336 | !EOP 337 | !BOC 338 | !----------------------------------------------------------------------- 339 | ! 340 | ! call SCRIP error print function to output any logged errors that 341 | ! were encountered during execution. Then stop. 342 | ! 343 | !----------------------------------------------------------------------- 344 | 345 | call SCRIP_ErrorPrint(errorCode) 346 | 347 | stop 348 | 349 | !----------------------------------------------------------------------- 350 | !EOC 351 | 352 | end subroutine CreateLatLonExit 353 | 354 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 355 | -------------------------------------------------------------------------------- /SCRIP/grids/OverlayGMV.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | program overlay_gmv 4 | 5 | !BOP 6 | ! !PROGRAM: SCRIP_driver 7 | ! 8 | ! !DESCRIPTION: 9 | ! This program is a standalone driver for writing a pair of NETCDF 10 | ! spherical grids out in GMV format 11 | ! 12 | ! The program reads the two file names from the command line 13 | ! To convert just one netcdf grid file to GMV, repeat the filename 1 14 | ! when queried for the second file 15 | ! 16 | ! !REVISION HISTORY: 17 | ! SVN:$Id: $ 18 | 19 | ! !USES: 20 | 21 | use SCRIP_KindsMod ! module defining data types 22 | use SCRIP_ErrorMod ! SCRIP error checking and logging 23 | use SCRIP_IOUnitsMod ! manages I/O units 24 | use grids ! module with grid information 25 | 26 | implicit none 27 | 28 | !EOP 29 | !BOC 30 | !----------------------------------------------------------------------- 31 | ! 32 | ! local variables 33 | ! 34 | !----------------------------------------------------------------------- 35 | 36 | integer (SCRIP_i4) :: & 37 | errorCode ! error flag 38 | 39 | character (SCRIP_charLength) :: & 40 | gridFile1, &! filename of grid file containing grid1 41 | gridFile2, &! filename of grid file containing grid2 42 | interpFile1, &! filename for output remap data (map1) 43 | interpFile2, &! filename for output remap data (map2) 44 | mapName1, &! name for mapping from grid1 to grid2 45 | mapName2, &! name for mapping from grid2 to grid1 46 | mapMethod, &! choice for mapping method 47 | normalizeOpt, &! option for normalizing weights 48 | outputFormat ! option for output conventions 49 | 50 | !----------------------------------------------------------------------- 51 | ! 52 | ! local variables 53 | ! 54 | !----------------------------------------------------------------------- 55 | 56 | integer (SCRIP_i4) :: & 57 | n, &! dummy counter 58 | iunit ! unit number for input configuration file 59 | 60 | integer (SCRIP_i4) :: i, j, j1, k, grid1_add, grid2_add, nseg=6 61 | integer (SCRIP_i4), dimension(:), allocatable :: & 62 | grid1_imask, grid2_imask 63 | real (SCRIP_r8) :: lat, lon, dlat, dlon 64 | real (SCRIP_r8), dimension(:,:), allocatable :: & 65 | grid1_corner_x, grid1_corner_y, grid1_corner_z, & 66 | grid2_corner_x, grid2_corner_y, grid2_corner_z, & 67 | grid1_corner_xp, grid2_corner_xp, & 68 | grid1_corner_yp, grid2_corner_yp, & 69 | grid1_corner_xp2, grid2_corner_xp2, & 70 | grid1_corner_yp2, grid2_corner_yp2 71 | 72 | 73 | !----------------------------------------------------------------------- 74 | ! 75 | ! initialize communication environment and SCRIP package 76 | ! 77 | !----------------------------------------------------------------------- 78 | 79 | errorCode = SCRIP_Success 80 | restrict_type = 'latitude' 81 | 82 | !----------------------------------------------------------------------- 83 | ! 84 | ! read input namelist 85 | ! 86 | !----------------------------------------------------------------------- 87 | 88 | write(SCRIP_stdout,*) 'Grid 1 File name' 89 | read(SCRIP_stdin,*) gridFile1 90 | write(SCRIP_stdout,*) 'Grid 2 File name' 91 | read(SCRIP_stdin,*) gridFile2 92 | 93 | !----------------------------------------------------------------------- 94 | ! 95 | ! initialize grid information for both grids 96 | ! 97 | !----------------------------------------------------------------------- 98 | 99 | call grid_init(gridFile1, gridFile2, errorCode) 100 | 101 | if (errorCode /= SCRIP_Success) then 102 | write(SCRIP_stdout,*) & 103 | 'SCRIP_driver: Error initializing grids' 104 | stop 105 | endif 106 | 107 | write(SCRIP_stdout, *) 'Write out combined GMV file for ', & 108 | grid1_name, ' and ', grid2_name 109 | write(SCRIP_stdout, *) 'Lat-Lon overlay in file grids_ll.gmv' 110 | write(SCRIP_stdout, *) 'XYZ overlay in file grids_xyz.gmv' 111 | 112 | 113 | !----------------------------------------------------------------------- 114 | ! 115 | ! write out grids in GMV format 116 | ! 117 | !----------------------------------------------------------------------- 118 | 119 | 120 | open(UNIT=11, FILE="grids_ll.gmv") ! Lon-Lat 121 | open(UNIT=12, FILE="grids_xyz.gmv") ! XYZ 122 | open(UNIT=13, FILE="grids_xyp.gmv") ! Lambert 123 | open(UNIT=14, FILE="grids_xyp2.gmv") ! Lambert with two segs 124 | open(UNIT=15, FILE="grids_llc.gmv") ! LonCoslat-Lat 125 | open(UNIT=16, FILE="grids_llc2.gmv") !LonCoslat-Lat with two segs 126 | 127 | write(11,'(A14)')'gmvinput ascii' 128 | write(12,'(A14)')'gmvinput ascii' 129 | write(13,'(A14)')'gmvinput ascii' 130 | write(14,'(A14)')'gmvinput ascii' 131 | write(15,'(A14)')'gmvinput ascii' 132 | write(16,'(A14)')'gmvinput ascii' 133 | 134 | 135 | allocate(grid1_corner_x(grid1_corners,grid1_size), & 136 | grid1_corner_y(grid1_corners,grid1_size), & 137 | grid1_corner_z(grid1_corners,grid1_size), & 138 | grid2_corner_x(grid2_corners,grid2_size), & 139 | grid2_corner_y(grid2_corners,grid2_size), & 140 | grid2_corner_z(grid2_corners,grid2_size), & 141 | grid1_corner_xp(grid1_corners,grid1_size), & 142 | grid1_corner_yp(grid1_corners,grid1_size), & 143 | grid2_corner_xp(grid2_corners,grid2_size), & 144 | grid2_corner_yp(grid2_corners,grid2_size), & 145 | grid1_corner_xp2(nseg*grid1_corners,grid1_size), & 146 | grid1_corner_yp2(nseg*grid1_corners,grid1_size), & 147 | grid2_corner_xp2(nseg*grid2_corners,grid2_size), & 148 | grid2_corner_yp2(nseg*grid2_corners,grid2_size)) 149 | allocate(grid1_imask(grid1_size),grid2_imask(grid2_size)) 150 | 151 | 152 | grid1_corner_x = cos(grid1_corner_lat)*cos(grid1_corner_lon) 153 | grid1_corner_y = cos(grid1_corner_lat)*sin(grid1_corner_lon) 154 | grid1_corner_z = sin(grid1_corner_lat) 155 | grid2_corner_x = cos(grid2_corner_lat)*cos(grid2_corner_lon) 156 | grid2_corner_y = cos(grid2_corner_lat)*sin(grid2_corner_lon) 157 | grid2_corner_z = sin(grid2_corner_lat) 158 | 159 | 160 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!! 161 | !******* Mapping *********** 162 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!! 163 | 164 | 165 | do i = 1, grid1_size 166 | if (grid1_center_lat(i) > pi/4.0) then 167 | k = 0 168 | do j = 1, grid1_corners 169 | lat = grid1_corner_lat(j,i) 170 | lon = grid1_corner_lon(j,i) 171 | grid1_corner_xp(j,i) = 2.0*sin(0.25*pi-0.5*lat)*cos(lon) 172 | grid1_corner_yp(j,i) = 2.0*sin(0.25*pi-0.5*lat)*sin(lon) 173 | 174 | j1 = 1 + mod(j,grid1_corners) 175 | dlat = grid1_corner_lat(j1,i)-grid1_corner_lat(j,i) 176 | dlon = grid1_corner_lon(j1,i)-grid1_corner_lon(j,i) 177 | if (dlon > pi) then 178 | dlon = dlon - pi2 179 | else if (dlon < -pi) then 180 | dlon = dlon + pi2 181 | endif 182 | 183 | do n = 1, nseg 184 | k = k+1 185 | lat = grid1_corner_lat(j,i) + dlat*(n-1)/nseg 186 | lon = grid1_corner_lon(j,i) + dlon*(n-1)/nseg 187 | grid1_corner_xp2(k,i) = & 188 | 2.0*sin(0.25*pi-0.5*lat)*cos(lon) 189 | grid1_corner_yp2(k,i) = & 190 | 2.0*sin(0.25*pi-0.5*lat)*sin(lon) 191 | enddo 192 | enddo 193 | else if (grid1_center_lat(i) < -pi/4.0) then 194 | k = 0 195 | do j = 1, grid1_corners 196 | lat = grid1_corner_lat(j,i) 197 | lon = grid1_corner_lon(j,i) 198 | grid1_corner_xp(j,i) = -2.0*sin(-0.25*pi-0.5*lat)*cos(lon) 199 | grid1_corner_yp(j,i) = 2.0*sin(-0.25*pi-0.5*lat)*sin(lon) 200 | grid1_corner_yp(j,i) = grid1_corner_yp(j,i) - 2.5 201 | 202 | j1 = 1 + mod(j,grid1_corners) 203 | dlat = grid1_corner_lat(j1,i)-grid1_corner_lat(j,i) 204 | dlon = grid1_corner_lon(j1,i)-grid1_corner_lon(j,i) 205 | if (dlon > pi) then 206 | dlon = dlon - pi2 207 | else if (dlon < -pi) then 208 | dlon = dlon + pi2 209 | endif 210 | 211 | do n = 1, nseg 212 | k = k+1 213 | lat = grid1_corner_lat(j,i) + dlat*(n-1)/nseg 214 | lon = grid1_corner_lon(j,i) + dlon*(n-1)/nseg 215 | grid1_corner_xp2(k,i) = & 216 | -2.0*sin(-0.25*pi-0.5*lat)*cos(lon) 217 | grid1_corner_yp2(k,i) = & 218 | 2.0*sin(-0.25*pi-0.5*lat)*sin(lon) - 2.5 219 | enddo 220 | 221 | enddo 222 | endif 223 | enddo 224 | 225 | do i = 1, grid2_size 226 | if (grid2_center_lat(i) > pi/4.0) then 227 | k = 0 228 | do j = 1, grid2_corners 229 | lat = grid2_corner_lat(j,i) 230 | lon = grid2_corner_lon(j,i) 231 | grid2_corner_xp(j,i) = 2.0*sin(0.25*pi-0.5*lat)*cos(lon) 232 | grid2_corner_yp(j,i) = 2.0*sin(0.25*pi-0.5*lat)*sin(lon) 233 | 234 | j1 = 1 + mod(j,grid2_corners) 235 | dlat = grid2_corner_lat(j1,i)-grid2_corner_lat(j,i) 236 | dlon = grid2_corner_lon(j1,i)-grid2_corner_lon(j,i) 237 | if (dlon > pi) then 238 | dlon = dlon - pi2 239 | else if (dlon < -pi) then 240 | dlon = dlon + pi2 241 | endif 242 | 243 | do n = 1, nseg 244 | k = k+1 245 | lat = grid2_corner_lat(j,i) + dlat*(n-1)/nseg 246 | lon = grid2_corner_lon(j,i) + dlon*(n-1)/nseg 247 | grid2_corner_xp2(k,i) = & 248 | 2.0*sin(0.25*pi-0.5*lat)*cos(lon) 249 | grid2_corner_yp2(k,i) = & 250 | 2.0*sin(0.25*pi-0.5*lat)*sin(lon) 251 | enddo 252 | enddo 253 | else if (grid2_center_lat(i) < -pi/4.0) then 254 | k = 0 255 | do j = 1, grid2_corners 256 | lat = grid2_corner_lat(j,i) 257 | lon = grid2_corner_lon(j,i) 258 | grid2_corner_xp(j,i) = -2.0*sin(-0.25*pi-0.5*lat)*cos(lon) 259 | grid2_corner_yp(j,i) = 2.0*sin(-0.25*pi-0.5*lat)*sin(lon) 260 | grid2_corner_yp(j,i) = grid2_corner_yp(j,i) - 2.5 261 | 262 | j1 = 1 + mod(j,grid2_corners) 263 | dlat = grid2_corner_lat(j1,i)-grid2_corner_lat(j,i) 264 | dlon = grid2_corner_lon(j1,i)-grid2_corner_lon(j,i) 265 | if (dlon > pi) then 266 | dlon = dlon - pi2 267 | else if (dlon < -pi) then 268 | dlon = dlon + pi2 269 | endif 270 | 271 | do n = 1, nseg 272 | k = k+1 273 | lat = grid2_corner_lat(j,i) + dlat*(n-1)/nseg 274 | lon = grid2_corner_lon(j,i) + dlon*(n-1)/nseg 275 | grid2_corner_xp2(k,i) = & 276 | -2.0*sin(-0.25*pi-0.5*lat)*cos(lon) 277 | grid2_corner_yp2(k,i) = & 278 | 2.0*sin(-0.25*pi-0.5*lat)*sin(lon) - 2.5 279 | enddo 280 | 281 | enddo 282 | endif 283 | enddo 284 | 285 | 286 | 287 | grid1_imask = 0 288 | do i = 1, grid1_size 289 | if (grid1_mask(i)) grid1_imask(i) = 1 290 | enddo 291 | grid2_imask = 0 292 | do i = 1, grid2_size 293 | if (grid2_mask(i)) grid2_imask(i) = 1 294 | enddo 295 | 296 | 297 | n = grid1_corners*grid1_size + grid2_corners*grid2_size 298 | write(11,'(A6,I10)')'nodev ',n 299 | write(12,'(A6,I10)')'nodev ',n 300 | write(13,'(A6,I10)')'nodev ',n 301 | write(14,'(A6,I10)')'nodev ',nseg*n 302 | 303 | do grid1_add = 1, grid1_size 304 | do i = 1, grid1_corners 305 | write(11,*) grid1_corner_lon(i,grid1_add), & 306 | grid1_corner_lat(i,grid1_add),0.0 307 | write(12,*) grid1_corner_x(i,grid1_add), & 308 | grid1_corner_y(i,grid1_add), & 309 | grid1_corner_z(i,grid1_add) 310 | write(13,*) grid1_corner_yp(i,grid1_add), & 311 | grid1_corner_xp(i,grid1_add),0.0 312 | enddo 313 | do i = 1, nseg*grid1_corners 314 | write(14,*) grid1_corner_yp2(i,grid1_add), & 315 | grid1_corner_xp2(i,grid1_add),0.0 316 | enddo 317 | enddo 318 | do grid2_add = 1, grid2_size 319 | do i = 1, grid2_corners 320 | write(11,*) grid2_corner_lon(i,grid2_add), & 321 | grid2_corner_lat(i,grid2_add),0.0 322 | write(12,*) grid2_corner_x(i,grid2_add), & 323 | grid2_corner_y(i,grid2_add), & 324 | grid2_corner_z(i,grid2_add) 325 | write(13,*) grid2_corner_yp(i,grid2_add), & 326 | grid2_corner_xp(i,grid2_add),0.0 327 | enddo 328 | do i = 1, nseg*grid2_corners 329 | write(14,*) grid2_corner_yp2(i,grid2_add), & 330 | grid2_corner_xp2(i,grid2_add),0.0 331 | enddo 332 | enddo 333 | 334 | 335 | 336 | write(11,'(A6,I10)') 'cells ',grid1_size+grid2_size 337 | write(12,'(A6,I10)') 'cells ',grid1_size+grid2_size 338 | write(13,'(A6,I10)') 'cells ',grid1_size+grid2_size 339 | write(14,'(A6,I10)') 'cells ',grid1_size+grid2_size 340 | 341 | n = 1 342 | if (grid1_corners .eq. 3) then 343 | do grid1_add = 1, grid1_size 344 | write(11,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid1_corners-1) 345 | write(12,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid1_corners-1) 346 | write(13,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid1_corners-1) 347 | n = n+grid1_corners 348 | enddo 349 | else if (grid1_corners .eq. 4) then 350 | do grid1_add = 1, grid1_size 351 | write(11,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid1_corners-1) 352 | write(12,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid1_corners-1) 353 | write(13,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid1_corners-1) 354 | n = n+grid1_corners 355 | enddo 356 | else 357 | do grid1_add = 1, grid1_size 358 | write(11,'(A10)') 'general 1 ' 359 | write(11,*) grid1_corners 360 | write(11,*) (i, i=n,n+grid1_corners-1) 361 | write(12,'(A10)') 'general 1 ' 362 | write(12,*) grid1_corners 363 | write(12,*) (i, i=n,n+grid1_corners-1) 364 | write(13,'(A10)') 'general 1 ' 365 | write(13,*) grid1_corners 366 | write(13,*) (i, i=n,n+grid1_corners-1) 367 | n = n+grid1_corners 368 | enddo 369 | endif 370 | if (grid2_corners .eq. 3) then 371 | do grid2_add = 1, grid2_size 372 | write(11,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid2_corners-1) 373 | write(12,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid2_corners-1) 374 | write(13,'(A6,20I10)') 'tri 3 ', (i, i=n,n+grid2_corners-1) 375 | n = n+grid2_corners 376 | enddo 377 | else if (grid2_corners .eq. 4) then 378 | do grid2_add = 1, grid2_size 379 | write(11,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid2_corners-1) 380 | write(12,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid2_corners-1) 381 | write(13,'(A6,20I10)') 'quad 4 ', (i, i=n,n+grid2_corners-1) 382 | n = n+grid2_corners 383 | enddo 384 | else 385 | do grid2_add = 1, grid2_size 386 | write(11,'(A10)') 'general 1 ' 387 | write(11,*) grid2_corners 388 | write(11,*) (i, i=n,n+grid2_corners-1) 389 | write(12,'(A10)') 'general 1 ' 390 | write(12,*) grid2_corners 391 | write(12,*) (i, i=n,n+grid2_corners-1) 392 | write(13,'(A10)') 'general 1 ' 393 | write(13,*) grid2_corners 394 | write(13,*) (i, i=n,n+grid2_corners-1) 395 | n = n+grid2_corners 396 | enddo 397 | endif 398 | 399 | n = 1 400 | do grid1_add = 1, grid1_size 401 | write(14,'(A10)') 'general 1 ' 402 | write(14,*) nseg*grid1_corners 403 | write(14,*) (i, i=n,n+nseg*grid1_corners-1) 404 | n = n+nseg*grid1_corners 405 | enddo 406 | do grid2_add = 1, grid2_size 407 | write(14,'(A10)') 'general 1 ' 408 | write(14,*) nseg*grid2_corners 409 | write(14,*) (i, i=n,n+nseg*grid2_corners-1) 410 | n = n+nseg*grid2_corners 411 | enddo 412 | 413 | write(11,'(A12)') 'material 2 0' 414 | write(11,'(A5)') 'grid1' 415 | write(11,'(A5)') 'grid2' 416 | write(12,'(A12)') 'material 2 0' 417 | write(12,'(A5)') 'grid1' 418 | write(12,'(A5)') 'grid2' 419 | write(13,'(A12)') 'material 2 0' 420 | write(13,'(A5)') 'grid1' 421 | write(13,'(A5)') 'grid2' 422 | write(14,'(A12)') 'material 2 0' 423 | write(14,'(A5)') 'grid1' 424 | write(14,'(A5)') 'grid2' 425 | 426 | write(11,'(10I2)') (1, i = 1,grid1_size) 427 | write(11,'(10I2)') (2, i = 1,grid2_size) 428 | write(12,'(10I2)') (1, i = 1,grid1_size) 429 | write(12,'(10I2)') (2, i = 1,grid2_size) 430 | write(13,'(10I2)') (1, i = 1,grid1_size) 431 | write(13,'(10I2)') (2, i = 1,grid2_size) 432 | write(14,'(10I2)') (1, i = 1,grid1_size) 433 | write(14,'(10I2)') (2, i = 1,grid2_size) 434 | 435 | write(11,'(A8)') 'variable' 436 | write(11,'(A10)') 'grid_mask 0' 437 | write(11,'(10I2)') (grid1_imask(i), i = 1,grid1_size) 438 | write(11,'(10I2)') (grid2_imask(i), i = 1,grid2_size) 439 | write(12,'(A8)') 'variable' 440 | write(12,'(A10)') 'grid_mask 0' 441 | write(12,'(10I2)') (grid1_imask(i), i = 1,grid1_size) 442 | write(12,'(10I2)') (grid2_imask(i), i = 1,grid2_size) 443 | write(13,'(A8)') 'variable' 444 | write(13,'(A10)') 'grid_mask 0' 445 | write(13,'(10I2)') (grid1_imask(i), i = 1,grid1_size) 446 | write(13,'(10I2)') (grid2_imask(i), i = 1,grid2_size) 447 | write(14,'(A8)') 'variable' 448 | write(14,'(A10)') 'grid_mask 0' 449 | write(14,'(10I2)') (grid1_imask(i), i = 1,grid1_size) 450 | write(14,'(10I2)') (grid2_imask(i), i = 1,grid2_size) 451 | 452 | write(11,'(A7)') 'endvars' 453 | write(12,'(A7)') 'endvars' 454 | write(13,'(A7)') 'endvars' 455 | write(14,'(A7)') 'endvars' 456 | 457 | write(11,'(A6)') 'endgmv' 458 | write(12,'(A6)') 'endgmv' 459 | write(13,'(A6)') 'endgmv' 460 | write(14,'(A6)') 'endgmv' 461 | 462 | close(11) 463 | close(12) 464 | close(13) 465 | close(14) 466 | 467 | 468 | end program overlay_gmv 469 | 470 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 471 | -------------------------------------------------------------------------------- /SCRIP/grids/README: -------------------------------------------------------------------------------- 1 | 2 | This directory contains some grid files in netCDF format 3 | for use in the SCRIP remapping package. 4 | 5 | In addition, there are several source codes for creating 6 | netCDF files for use in SCRIP: 7 | 8 | CreateLatLon.F90 - creates a simple lat/lon grid for SCRIP 9 | 10 | convertPOPT.f - converts input grid files for the POP 11 | ocean model to SCRIP netCDF format 12 | 13 | convertgauss.f - creates a SCRIP netCDF grid file for 14 | a Gaussian lat/lon grid that a global 15 | spectral model would use 16 | 17 | convert_old.f - converts old grid files from a previous 18 | version of the SCRIP routines 19 | 20 | -------------------------------------------------------------------------------- /SCRIP/grids/convert_old.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! This file converts a POP grid.dat file to a remapping grid file 4 | ! in netCDF format. 5 | ! 6 | !----------------------------------------------------------------------- 7 | ! 8 | ! CVS:$Id: convert_old.f,v 1.2 2000/04/19 22:05:57 pwjones Exp $ 9 | ! 10 | ! Copyright (c) 1997, 1998 the Regents of the University of 11 | ! California. 12 | ! 13 | ! Unless otherwise indicated, this software has been authored 14 | ! by an employee or employees of the University of California, 15 | ! operator of the Los Alamos National Laboratory under Contract 16 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 17 | ! Government has rights to use, reproduce, and distribute this 18 | ! software. The public may copy and use this software without 19 | ! charge, provided that this Notice and any statement of authorship 20 | ! are reproduced on all copies. Neither the Government nor the 21 | ! University makes any warranty, express or implied, or assumes 22 | ! any liability or responsibility for the use of this software. 23 | ! 24 | !*********************************************************************** 25 | 26 | program convertPOPT 27 | 28 | !----------------------------------------------------------------------- 29 | ! 30 | ! This file converts a POP grid.dat file to a remapping grid file. 31 | ! 32 | !----------------------------------------------------------------------- 33 | 34 | use SCRIP_KindsMod 35 | use constants 36 | use SCRIP_IOUnitsMod 37 | use netcdf_mod 38 | use netcdf 39 | 40 | implicit none 41 | 42 | !----------------------------------------------------------------------- 43 | ! 44 | ! variables that describe the grid 45 | ! 46 | !----------------------------------------------------------------------- 47 | 48 | integer (kind=SCRIP_i4) :: 49 | & grid_size, grid_rank, grid_corners 50 | 51 | integer (kind=SCRIP_i4), dimension(2) :: 52 | & grid_dims ! size of each dimension 53 | 54 | character(SCRIP_CharLength) :: 55 | & grid_name 56 | 57 | character(SCRIP_CharLength), parameter :: 58 | & grid_file_in = 'remap_grid_WWice.dat', 59 | & grid_file_out = 'remap_grid_WWice.nc' 60 | 61 | !----------------------------------------------------------------------- 62 | ! 63 | ! grid coordinates and masks 64 | ! 65 | !----------------------------------------------------------------------- 66 | 67 | integer (kind=SCRIP_i4), dimension(:), allocatable :: 68 | & grid_imask 69 | 70 | real (kind=SCRIP_r8), dimension(:), allocatable :: 71 | & grid_center_lat, ! lat/lon coordinates for 72 | & grid_center_lon ! each grid center in radians 73 | 74 | real (kind=SCRIP_r8), dimension(:,:), allocatable :: 75 | & grid_corner_lat, ! lat/lon coordinates for 76 | & grid_corner_lon ! each grid corner in radians 77 | 78 | !----------------------------------------------------------------------- 79 | ! 80 | ! other local variables 81 | ! 82 | !----------------------------------------------------------------------- 83 | 84 | integer (kind=SCRIP_i4) :: i, j, n, iunit, ocn_add, im1, jm1 85 | 86 | integer (kind=SCRIP_i4) :: 87 | & ncstat, ! general netCDF status variable 88 | & nc_grid_id, ! netCDF grid dataset id 89 | & nc_gridsize_id, ! netCDF grid size dim id 90 | & nc_gridcorn_id, ! netCDF grid corner dim id 91 | & nc_gridrank_id, ! netCDF grid rank dim id 92 | & nc_griddims_id, ! netCDF grid dimensions id 93 | & nc_grdcntrlat_id, ! netCDF grid center lat id 94 | & nc_grdcntrlon_id, ! netCDF grid center lon id 95 | & nc_grdimask_id, ! netCDF grid mask id 96 | & nc_grdcrnrlat_id, ! netCDF grid corner lat id 97 | & nc_grdcrnrlon_id ! netCDF grid corner lon id 98 | 99 | integer (kind=SCRIP_i4), dimension(2) :: 100 | & nc_dims2_id ! netCDF dim id array for 2-d arrays 101 | 102 | real (kind=SCRIP_r8) :: tmplon 103 | 104 | !----------------------------------------------------------------------- 105 | ! 106 | ! read in grid info 107 | ! lat/lon info is on velocity points which correspond 108 | ! to the NE corner (in logical space) of the grid cell. 109 | ! 110 | !----------------------------------------------------------------------- 111 | 112 | call get_unit(iunit) 113 | open(unit=iunit, file=grid_file_in, status='old', 114 | & form='unformatted') 115 | 116 | read(iunit) grid_name 117 | read(iunit) grid_size, grid_corners, grid_rank, grid_dims 118 | 119 | allocate( grid_center_lat(grid_size), 120 | & grid_center_lon(grid_size), 121 | & grid_imask (grid_size), 122 | & grid_corner_lat(grid_corners, grid_size), 123 | & grid_corner_lon(grid_corners, grid_size) ) 124 | 125 | read(iunit) grid_center_lat 126 | read(iunit) grid_center_lon 127 | read(iunit) grid_corner_lat 128 | read(iunit) grid_corner_lon 129 | read(iunit) grid_imask 130 | call release_unit(iunit) 131 | 132 | !----------------------------------------------------------------------- 133 | ! 134 | ! set up attributes for netCDF file 135 | ! 136 | !----------------------------------------------------------------------- 137 | 138 | !*** 139 | !*** create netCDF dataset for this grid 140 | !*** 141 | 142 | ncstat = nf90_create (grid_file_out, NF90_CLOBBER, 143 | & nc_grid_id) 144 | call netcdf_error_handler(ncstat) 145 | 146 | ncstat = nf90_put_att_text (nc_grid_id, NF90_GLOBAL, 'title', 147 | & len_trim(grid_name), grid_name) 148 | call netcdf_error_handler(ncstat) 149 | 150 | !*** 151 | !*** define grid size dimension 152 | !*** 153 | 154 | ncstat = nf90_def_dim (nc_grid_id, 'grid_size', grid_size, 155 | & nc_gridsize_id) 156 | call netcdf_error_handler(ncstat) 157 | 158 | !*** 159 | !*** define grid rank dimension 160 | !*** 161 | 162 | ncstat = nf90_def_dim (nc_grid_id, 'grid_rank', grid_rank, 163 | & nc_gridrank_id) 164 | call netcdf_error_handler(ncstat) 165 | 166 | !*** 167 | !*** define grid corner dimension 168 | !*** 169 | 170 | ncstat = nf90_def_dim (nc_grid_id, 'grid_corners', grid_corners, 171 | & nc_gridcorn_id) 172 | call netcdf_error_handler(ncstat) 173 | 174 | !*** 175 | !*** define grid dim size array 176 | !*** 177 | 178 | ncstat = nf90_def_var (nc_grid_id, 'grid_dims', NF90_INT, 179 | & 1, nc_gridrank_id, nc_griddims_id) 180 | call netcdf_error_handler(ncstat) 181 | 182 | !*** 183 | !*** define grid center latitude array 184 | !*** 185 | 186 | ncstat = nf90_def_var (nc_grid_id, 'grid_center_lat', NF90_DOUBLE, 187 | & 1, nc_gridsize_id, nc_grdcntrlat_id) 188 | call netcdf_error_handler(ncstat) 189 | 190 | ncstat = nf90_put_att_text (nc_grid_id, nc_grdcntrlat_id, 'units', 191 | & 7, 'radians') 192 | call netcdf_error_handler(ncstat) 193 | 194 | !*** 195 | !*** define grid center longitude array 196 | !*** 197 | 198 | ncstat = nf90_def_var (nc_grid_id, 'grid_center_lon', NF90_DOUBLE, 199 | & 1, nc_gridsize_id, nc_grdcntrlon_id) 200 | call netcdf_error_handler(ncstat) 201 | 202 | ncstat = nf90_put_att_text (nc_grid_id, nc_grdcntrlon_id, 'units', 203 | & 7, 'radians') 204 | call netcdf_error_handler(ncstat) 205 | 206 | !*** 207 | !*** define grid mask 208 | !*** 209 | 210 | ncstat = nf90_def_var (nc_grid_id, 'grid_imask', NF90_INT, 211 | & 1, nc_gridsize_id, nc_grdimask_id) 212 | call netcdf_error_handler(ncstat) 213 | 214 | ncstat = nf90_put_att_text (nc_grid_id, nc_grdimask_id, 'units', 215 | & 8, 'unitless') 216 | call netcdf_error_handler(ncstat) 217 | 218 | !*** 219 | !*** define grid corner latitude array 220 | !*** 221 | 222 | nc_dims2_id(1) = nc_gridcorn_id 223 | nc_dims2_id(2) = nc_gridsize_id 224 | 225 | ncstat = nf90_def_var (nc_grid_id, 'grid_corner_lat', NF90_DOUBLE, 226 | & 2, nc_dims2_id, nc_grdcrnrlat_id) 227 | call netcdf_error_handler(ncstat) 228 | 229 | ncstat = nf90_put_att_text (nc_grid_id, nc_grdcrnrlat_id, 'units', 230 | & 7, 'radians') 231 | call netcdf_error_handler(ncstat) 232 | 233 | !*** 234 | !*** define grid corner longitude array 235 | !*** 236 | 237 | ncstat = nf90_def_var (nc_grid_id, 'grid_corner_lon', NF90_DOUBLE, 238 | & 2, nc_dims2_id, nc_grdcrnrlon_id) 239 | call netcdf_error_handler(ncstat) 240 | 241 | ncstat = nf90_put_att_text (nc_grid_id, nc_grdcrnrlon_id, 'units', 242 | & 7, 'radians') 243 | call netcdf_error_handler(ncstat) 244 | 245 | !*** 246 | !*** end definition stage 247 | !*** 248 | 249 | ncstat = nf90_enddef(nc_grid_id) 250 | call netcdf_error_handler(ncstat) 251 | 252 | !----------------------------------------------------------------------- 253 | ! 254 | ! write grid data 255 | ! 256 | !----------------------------------------------------------------------- 257 | 258 | ncstat = nf90_put_var_int(nc_grid_id, nc_griddims_id, grid_dims) 259 | call netcdf_error_handler(ncstat) 260 | 261 | ncstat = nf90_put_var_double(nc_grid_id, nc_grdcntrlat_id, 262 | & grid_center_lat) 263 | ncstat = nf90_put_var_int(nc_grid_id, nc_grdimask_id, grid_imask) 264 | call netcdf_error_handler(ncstat) 265 | 266 | ncstat = nf90_put_var_double(nc_grid_id, nc_grdcntrlat_id, 267 | & grid_center_lat) 268 | call netcdf_error_handler(ncstat) 269 | 270 | ncstat = nf90_put_var_double(nc_grid_id, nc_grdcntrlon_id, 271 | & grid_center_lon) 272 | call netcdf_error_handler(ncstat) 273 | 274 | ncstat = nf90_put_var_double(nc_grid_id, nc_grdcrnrlat_id, 275 | & grid_corner_lat) 276 | call netcdf_error_handler(ncstat) 277 | 278 | ncstat = nf90_put_var_double(nc_grid_id, nc_grdcrnrlon_id, 279 | & grid_corner_lon) 280 | call netcdf_error_handler(ncstat) 281 | 282 | ncstat = nf90_close(nc_grid_id) 283 | 284 | !*********************************************************************** 285 | 286 | end program convertPOPT 287 | 288 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 289 | -------------------------------------------------------------------------------- /SCRIP/grids/makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile for interpolation code 3 | # CVS:$Id: makefile,v 1.3 2000/04/19 22:05:59 pwjones Exp $ 4 | # 5 | 6 | COMP = gfortran 7 | NETCDFINC = -I/usr/local/include 8 | NETCDFLIB = -L/usr/local/lib 9 | #NETCDFINC = -I$(HOME)/packages/netcdf-3.6.3-x86_64_linux/include 10 | #NETCDFLIB = -L$(HOME)/packages/netcdf-3.6.3-x86_64_linux/lib 11 | FLAGS = -O3 $(NETCDFINC) 12 | #FLAGS = -g 13 | LIB = $(NETCDFLIB) -lnetcdf 14 | INCL = 15 | SRCDIR = ../source 16 | EXEDIR = . 17 | OBJ = \ 18 | SCRIP_KindsMod.o \ 19 | SCRIP_ErrorMod.o \ 20 | SCRIP_IOUnitsMod.o \ 21 | SCRIP_NetcdfMod.o \ 22 | constants.o \ 23 | grids.o 24 | 25 | all: CreateLatLon OverlayGMV convertgauss convertPOPT 26 | 27 | CreateLatLon: $(OBJ) CreateLatLon.o 28 | $(COMP) $(FLAGS) $(OBJ) CreateLatLon.o $(LIB) -o $(EXEDIR)/CreateLatLon 29 | 30 | OverlayGMV: $(OBJ) OverlayGMV.o 31 | $(COMP) $(FLAGS) $(OBJ) OverlayGMV.o $(LIB) -o $(EXEDIR)/OverlayGMV 32 | 33 | convertgauss: $(OBJ) convertgauss.o 34 | $(COMP) $(FLAGS) $(OBJ) convertgauss.o $(LIB) -o $(EXEDIR)/convertgauss 35 | 36 | convertPOPT: $(OBJ) convertPOPT.o 37 | $(COMP) $(FLAGS) $(OBJ) convertPOPT.o $(LIB) -o $(EXEDIR)/convertPOPT 38 | 39 | SCRIP_KindsMod.o: $(SRCDIR)/SCRIP_KindsMod.F90 $(INCL) 40 | $(COMP) $(FLAGS) -c $(SRCDIR)/SCRIP_KindsMod.F90 41 | 42 | SCRIP_IOUnitsMod.o: $(SRCDIR)/SCRIP_IOUnitsMod.F90 SCRIP_KindsMod.o $(INCL) 43 | $(COMP) $(FLAGS) -c $(SRCDIR)/SCRIP_IOUnitsMod.F90 44 | 45 | SCRIP_ErrorMod.o: $(SRCDIR)/SCRIP_ErrorMod.F90 SCRIP_KindsMod.o SCRIP_IOUnitsMod.o $(INCL) 46 | $(COMP) $(FLAGS) -c $(SRCDIR)/SCRIP_ErrorMod.F90 47 | 48 | SCRIP_NetcdfMod.o: $(SRCDIR)/SCRIP_NetcdfMod.F90 SCRIP_KindsMod.o SCRIP_ErrorMod.o $(INCL) 49 | $(COMP) $(FLAGS) -c $(SRCDIR)/SCRIP_NetcdfMod.F90 50 | 51 | constants.o: $(SRCDIR)/constants.f SCRIP_KindsMod.o $(INCL) 52 | $(COMP) $(FLAGS) -c $(SRCDIR)/constants.f 53 | 54 | grids.o: $(SRCDIR)/grids.f SCRIP_NetcdfMod.o SCRIP_KindsMod.o SCRIP_ErrorMod.o $(INCL) 55 | $(COMP) $(FLAGS) -c $(SRCDIR)/grids.f 56 | 57 | CreateLatLon.o: CreateLatLon.F90 SCRIP_KindsMod.o SCRIP_ErrorMod.o SCRIP_NetcdfMod.o $(INCL) 58 | $(COMP) $(FLAGS) -c CreateLatLon.F90 59 | 60 | OverlayGMV.o: OverlayGMV.F90 SCRIP_KindsMod.o SCRIP_ErrorMod.o SCRIP_NetcdfMod.o grids.o constants.o $(INCL) 61 | $(COMP) $(FLAGS) -c OverlayGMV.F90 62 | 63 | convertgauss.o: convertgauss.f SCRIP_KindsMod.o SCRIP_ErrorMod.o SCRIP_NetcdfMod.o grids.o constants.o $(INCL) 64 | $(COMP) $(FLAGS) -c convertgauss.f 65 | 66 | convertPOPT.o: convertPOPT.f SCRIP_KindsMod.o SCRIP_ErrorMod.o SCRIP_NetcdfMod.o grids.o constants.o $(INCL) 67 | $(COMP) $(FLAGS) -c convertPOPT.f 68 | 69 | clean: 70 | /bin/rm CreateLatLon OverlayGMV convertgauss convertPOPT *.o *.mod 71 | 72 | -------------------------------------------------------------------------------- /SCRIP/grids/remap_grid_POP43.nc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SCRIP-Project/SCRIP/a5d6960ac96269d5c3adbd620ef024c94d32b488/SCRIP/grids/remap_grid_POP43.nc -------------------------------------------------------------------------------- /SCRIP/grids/remap_grid_T42.nc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SCRIP-Project/SCRIP/a5d6960ac96269d5c3adbd620ef024c94d32b488/SCRIP/grids/remap_grid_T42.nc -------------------------------------------------------------------------------- /SCRIP/scrip_in: -------------------------------------------------------------------------------- 1 | &remapInputs 2 | num_maps = 2 3 | gridFile1 = 'grids/remap_grid_POP43.nc' 4 | gridFile2 = 'grids/remap_grid_T42.nc' 5 | interpFile1 = 'rmp_POP43_to_T42_conserv.nc' 6 | interpFile2 = 'rmp_T42_to_POP43_conserv.nc' 7 | mapName1 = 'POP43 to T42 Conservative Mapping' 8 | mapName2 = 'T42 to POP43 Conservative Mapping' 9 | mapMethod = 'conservative' 10 | normalizeOpt = 'fracArea' 11 | outputFormat = 'scrip' 12 | restrict_type = 'latitude' 13 | num_srch_bins = 90 14 | luse_grid1_area = .false. 15 | luse_grid2_area = .false. 16 | / 17 | -------------------------------------------------------------------------------- /SCRIP/scrip_test_in: -------------------------------------------------------------------------------- 1 | &remap_inputs 2 | field_choice = 2 3 | interp_file = '../rmp_T42_to_POP43_conserv.nc' 4 | output_file = 'out_T42_to_POP43_conserv.nc' 5 | / 6 | -------------------------------------------------------------------------------- /SCRIP/setupTargetDir: -------------------------------------------------------------------------------- 1 | #!/bin/csh 2 | # 3 | # This script sets up target directories for scrip and 4 | # two test codes. The main directory (directory_name) 5 | # will contain the main scrip driver and two subdirectories 6 | # called test and testRepeat will contain drivers for the 7 | # two test drivers. 8 | # 9 | # Usage: 10 | # setupTargetDir directory_name 11 | # where 12 | # directory_name is the user-supplied name of a 13 | # directory that may or may not exist. 14 | # 15 | if ($1 == "") then 16 | echo "Directory name argument must be supplied" 17 | echo "Usage: setupTargetDir directory_name" 18 | echo "where directory_name is the name of a directory" 19 | echo " that may or may not exist." 20 | exit 1 21 | else 22 | set workdir = $1 23 | echo "Directory set to $workdir" 24 | endif 25 | 26 | # Check for valid SCRIP directory 27 | 28 | if (-e $SCRIPDIR) then 29 | # catch relative path case by checking whether build dir exists 30 | if (-e $SCRIPDIR/build) then 31 | echo "Using SCRIP distribution in $SCRIPDIR" 32 | else 33 | echo "The value $SCRIPDIR for SCRIPDIR is not a valid SCRIP distribution" 34 | exit 2 35 | endif 36 | else 37 | echo "The value $SCRIPDIR for SCRIPDIR is not a valid SCRIP distribution" 38 | exit 2 39 | endif 40 | 41 | # Make the requested working directory tree 42 | 43 | if (-e $workdir) then 44 | echo "Directory $workdir exists" 45 | if (-e $workdir/test) then 46 | echo "Directory $workdir/test exists" 47 | else 48 | echo "Test directory does not exist; creating" 49 | mkdir $workdir/test 50 | chmod 0775 $workdir/test 51 | endif 52 | if (-e $workdir/testRepeat) then 53 | echo "Directory $workdir/testRepeat exists" 54 | else 55 | echo "TestRepeat directory does not exist; creating" 56 | mkdir $workdir/testRepeat 57 | chmod 0775 $workdir/testRepeat 58 | endif 59 | else 60 | echo "Directory $workdir does not exist; creating" 61 | mkdir $workdir 62 | mkdir $workdir/test 63 | mkdir $workdir/testRepeat 64 | chmod -R 0775 $workdir 65 | endif 66 | 67 | # Copy makefiles into the working directory 68 | 69 | if ($?SCRIPDIR) then 70 | echo "Copying makefiles from $SCRIPDIR/build" 71 | if (-e $SCRIPDIR/build/GNUmakefile) then 72 | cp $SCRIPDIR/build/GNUmakefile $workdir 73 | else 74 | echo "ERROR: could not find $SCRIPDIR/build/GNUmakefile" 75 | endif 76 | if (-e $SCRIPDIR/build/GNUmakefileTest) then 77 | cp $SCRIPDIR/build/GNUmakefileTest $workdir/test/GNUmakefile 78 | else 79 | echo "ERROR: could not find $SCRIPDIR/build/GNUmakefileTest" 80 | endif 81 | if (-e $SCRIPDIR/build/GNUmakefileTestRepeat) then 82 | cp $SCRIPDIR/build/GNUmakefileTestRepeat $workdir/testRepeat/GNUmakefile 83 | else 84 | echo "ERROR: could not find $SCRIPDIR/build/GNUmakefileTestRepeat" 85 | endif 86 | else 87 | echo "SCRIPDIR environment not yet specified; must setenv SCRIPDIR" 88 | exit 3 89 | endif 90 | 91 | # Copy driver files and sample inputs 92 | 93 | cp $SCRIPDIR/scrip_in $workdir 94 | cp $SCRIPDIR/scrip_test_in $workdir/test 95 | cp $SCRIPDIR/scrip_test_in $workdir/testRepeat 96 | 97 | cp $SCRIPDIR/drivers/SCRIP_driver.F90 $workdir 98 | cp $SCRIPDIR/drivers/scrip_test.f $workdir/test 99 | cp $SCRIPDIR/drivers/scrip_test_repeat.f $workdir/testRepeat 100 | 101 | -------------------------------------------------------------------------------- /SCRIP/source/SCRIP_ErrorMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | module SCRIP_ErrorMod 4 | 5 | !BOP 6 | ! !MODULE: SCRIP_ErrorMod 7 | ! !DESCRIPTION: 8 | ! This module contains SCRIP error flags and facilities for logging and 9 | ! printing error messages. Note that error flags are local to a 10 | ! process and there is no synchronization of error flags across 11 | ! processes. As routines trap error flags, they may add a message 12 | ! to the error log to aid in tracking the call sequence. 13 | ! 14 | ! Users should not need to change any values in this module. 15 | ! 16 | ! All routines in SCRIP which encounter an error should return to 17 | ! the calling routine with the SCRIP\_Fail error code set and a message 18 | ! added to the error log using the SCRIP\_ErrorCheck or 19 | ! SCRIP\_ErrorSet function. Routines in SCRIP should also check 20 | ! error codes returned by called routines and add a message to the 21 | ! error log to help users track the calling sequence that generated 22 | ! the error. This process enables the error code to be propagated 23 | ! to the highest level or calling routine to enable a graceful 24 | ! exit. At that level, the SCRIP_ErrorPrint call can be used to 25 | ! print the entire error trace or error log. 26 | ! 27 | ! !REVISION HISTORY: 28 | ! SVN:$Id: SCRIP_ErrorMod.F90 14 2006-08-17 17:07:05Z $ 29 | ! 30 | ! !USES: 31 | 32 | use SCRIP_KindsMod 33 | !use SCRIP_CommMod 34 | use SCRIP_IOUnitsMod 35 | 36 | implicit none 37 | private 38 | save 39 | 40 | ! !DEFINED PARAMETERS: 41 | 42 | integer (SCRIP_i4), parameter, public :: & 43 | SCRIP_Success = 0, & ! standard SCRIP error flags 44 | SCRIP_Fail = -1 45 | 46 | ! !PUBLIC MEMBER FUNCTIONS: 47 | 48 | public :: SCRIP_ErrorSet, & 49 | SCRIP_ErrorCheck, & 50 | SCRIP_ErrorPrint 51 | 52 | !EOP 53 | !BOC 54 | !----------------------------------------------------------------------- 55 | ! 56 | ! module variables 57 | ! 58 | !----------------------------------------------------------------------- 59 | 60 | integer (SCRIP_i4), parameter :: & 61 | SCRIP_errorLogDepth = 20 ! Max depth of call tree to properly 62 | ! size the error log array 63 | 64 | integer (SCRIP_i4) :: & 65 | SCRIP_errorMsgCount = 0 ! tracks current number of log messages 66 | 67 | character (SCRIP_CharLength), dimension(SCRIP_ErrorLogDepth) :: & 68 | SCRIP_errorLog ! list of error messages to be output 69 | 70 | !EOC 71 | !*********************************************************************** 72 | 73 | contains 74 | 75 | !*********************************************************************** 76 | !BOP 77 | ! !IROUTINE: SCRIP_ErrorSet -- sets error code and logs error message 78 | ! !INTERFACE: 79 | 80 | subroutine SCRIP_ErrorSet(errorCode, rtnName, errorMsg) 81 | 82 | ! !DESCRIPTION: 83 | ! This routine sets an error code to SCRIP\_Fail and adds a message to 84 | ! the error log for later printing. 85 | ! 86 | ! !REVISION HISTORY: 87 | ! same as module 88 | 89 | ! !OUTPUT PARAMETERS: 90 | 91 | integer (SCRIP_i4), intent(out) :: & 92 | errorCode ! Error code to set to fail 93 | 94 | ! !INPUT PARAMETERS: 95 | 96 | character (*), intent(in) :: & 97 | rtnName, &! name of calling routine 98 | errorMsg ! message to add to error log for printing 99 | 100 | !EOP 101 | !BOC 102 | !----------------------------------------------------------------------- 103 | ! 104 | ! Local variables 105 | ! 106 | !----------------------------------------------------------------------- 107 | 108 | character(len(rtnName)+len(errorMsg)+2) :: & 109 | logErrorMsg ! constructed error message with routine name 110 | 111 | !----------------------------------------------------------------------- 112 | ! 113 | ! Set error code to fail 114 | ! 115 | !----------------------------------------------------------------------- 116 | 117 | errorCode = SCRIP_Fail 118 | 119 | !----------------------------------------------------------------------- 120 | ! 121 | ! Add error message to error log 122 | ! 123 | !----------------------------------------------------------------------- 124 | 125 | SCRIP_errorMsgCount = SCRIP_errorMsgCount + 1 126 | 127 | if (SCRIP_errorMsgCount <= SCRIP_errorLogDepth) then 128 | write(logErrorMsg,'(a,a2,a)') rtnName,': ',errorMsg 129 | SCRIP_errorLog(SCRIP_errorMsgCount) = logErrorMsg 130 | endif 131 | 132 | !----------------------------------------------------------------------- 133 | !EOC 134 | 135 | end subroutine SCRIP_ErrorSet 136 | 137 | !*********************************************************************** 138 | !BOP 139 | ! !IROUTINE: SCRIP_ErrorCheck -- checks error code and logs error message 140 | ! !INTERFACE: 141 | 142 | function SCRIP_ErrorCheck(errorCode, rtnName, errorMsg) 143 | 144 | ! !DESCRIPTION: 145 | ! This function checks an error code and adds a message to the error 146 | ! log for later printing. It is a more compact form of the ErrorSet 147 | ! routine that is especially useful for checking an error code after 148 | ! returning from a routine or function. If the errorCode is the 149 | ! failure code SCRIP\_Fail, it returns a logical true value so that 150 | ! it can be used in a typical call like: 151 | ! \begin{verbatim} 152 | ! if (SCRIP_ErrorCheck(errorCode, rtnName, errorMsg)) return 153 | ! \end{verbatim} 154 | ! 155 | ! !REVISION HISTORY: 156 | ! same as module 157 | 158 | ! !OUTPUT PARAMETERS: 159 | 160 | logical (SCRIP_logical) :: & 161 | SCRIP_ErrorCheck 162 | 163 | ! !INPUT PARAMETERS: 164 | 165 | integer (SCRIP_i4), intent(in) :: & 166 | errorCode ! Error code to check 167 | 168 | character (*), intent(in) :: & 169 | rtnName, &! name of calling routine 170 | errorMsg ! message to add to error log for printing 171 | 172 | !EOP 173 | !BOC 174 | !----------------------------------------------------------------------- 175 | ! 176 | ! local variables 177 | ! 178 | !----------------------------------------------------------------------- 179 | 180 | character (SCRIP_charLength) :: & 181 | logErrorMsg ! constructed error message with routine name 182 | 183 | !----------------------------------------------------------------------- 184 | ! 185 | ! If the error code is success, set the return value to false. 186 | ! 187 | !----------------------------------------------------------------------- 188 | 189 | if (errorCode == SCRIP_Success) then 190 | SCRIP_ErrorCheck = .false. 191 | 192 | !----------------------------------------------------------------------- 193 | ! 194 | ! If the error code is a fail, set the return value to true and 195 | ! add the error message to the log. 196 | ! 197 | !----------------------------------------------------------------------- 198 | 199 | else 200 | SCRIP_ErrorCheck = .true. 201 | 202 | SCRIP_errorMsgCount = SCRIP_errorMsgCount + 1 203 | 204 | if (SCRIP_errorMsgCount <= SCRIP_errorLogDepth) then 205 | write(logErrorMsg,'(a,a2,a)') rtnName,': ',errorMsg 206 | SCRIP_errorLog(SCRIP_errorMsgCount) = logErrorMsg 207 | endif 208 | endif 209 | 210 | !----------------------------------------------------------------------- 211 | !EOC 212 | 213 | end function SCRIP_ErrorCheck 214 | 215 | !*********************************************************************** 216 | !BOP 217 | ! !IROUTINE: SCRIP_ErrorPrint -- prints the error log 218 | ! !INTERFACE: 219 | 220 | subroutine SCRIP_ErrorPrint(errorCode, printTask) 221 | 222 | ! !DESCRIPTION: 223 | ! This routine prints all messages in the error log. If a printTask 224 | ! is specified, only the message log on that task will be printed. 225 | ! 226 | ! !REVISION HISTORY: 227 | ! same as module 228 | 229 | ! !INPUT PARAMETERS: 230 | 231 | integer (SCRIP_i4), intent(in) :: & 232 | errorCode ! input error code to check success/fail 233 | 234 | !*** currently this has no meaning, but will be used in parallel 235 | !*** SCRIP version 236 | integer (SCRIP_i4), intent(in), optional :: & 237 | printTask ! Task from which to print error log 238 | 239 | !EOP 240 | !BOC 241 | !----------------------------------------------------------------------- 242 | ! 243 | ! local variables 244 | ! 245 | !----------------------------------------------------------------------- 246 | 247 | integer (SCRIP_i4) :: n 248 | 249 | !----------------------------------------------------------------------- 250 | ! 251 | ! Print all error messages to stdout 252 | ! 253 | !----------------------------------------------------------------------- 254 | 255 | if (present(printTask)) then 256 | 257 | !*** parallel SCRIP not yet supported 258 | !if (SCRIP_myTask == printTask) then 259 | 260 | write(SCRIP_stdout,SCRIP_blankFormat) 261 | write(SCRIP_stdout,SCRIP_delimFormat) 262 | write(SCRIP_stdout,SCRIP_blankFormat) 263 | 264 | if (SCRIP_errorMsgCount == 0) then ! no errors 265 | 266 | write(SCRIP_stdout,'(a34)') & 267 | 'Successful completion of SCRIP model' 268 | 269 | else 270 | 271 | write(SCRIP_stdout,'(a14)') 'SCRIP Exiting...' 272 | 273 | do n=1,min(SCRIP_errorMsgCount,SCRIP_errorLogDepth) 274 | write(SCRIP_stderr,'(a)') trim(SCRIP_errorLog(n)) 275 | if (SCRIP_stdout /= SCRIP_stderr) then 276 | write(SCRIP_stdout,'(a)') trim(SCRIP_errorLog(n)) 277 | endif 278 | end do 279 | 280 | if (SCRIP_errorMsgCount > SCRIP_errorLogDepth) then 281 | write(SCRIP_stderr,'(a23)') 'Too many error messages' 282 | if (SCRIP_stdout /= SCRIP_stderr) then 283 | write(SCRIP_stdout,'(a23)') 'Too many error messages' 284 | endif 285 | endif 286 | 287 | endif 288 | 289 | write(SCRIP_stdout,SCRIP_blankFormat) 290 | write(SCRIP_stdout,SCRIP_delimFormat) 291 | write(SCRIP_stdout,SCRIP_blankFormat) 292 | 293 | !endif 294 | 295 | else 296 | 297 | write(SCRIP_stdout,SCRIP_blankFormat) 298 | write(SCRIP_stdout,SCRIP_delimFormat) 299 | write(SCRIP_stdout,SCRIP_blankFormat) 300 | 301 | if (SCRIP_errorMsgCount == 0) then ! no errors 302 | 303 | write(SCRIP_stdout,'(a34)') 'Successful completion of SCRIP' 304 | 305 | else 306 | 307 | write(SCRIP_stdout,'(a14)') 'SCRIP Exiting...' 308 | 309 | do n=1,min(SCRIP_errorMsgCount,SCRIP_errorLogDepth) 310 | write(SCRIP_stderr,'(a)') trim(SCRIP_errorLog(n)) 311 | if (SCRIP_stdout /= SCRIP_stderr) then 312 | write(SCRIP_stdout,'(a)') trim(SCRIP_errorLog(n)) 313 | endif 314 | end do 315 | 316 | if (SCRIP_errorMsgCount > SCRIP_errorLogDepth) then 317 | write(SCRIP_stderr,'(a23)') 'Too many error messages' 318 | if (SCRIP_stdout /= SCRIP_stderr) then 319 | write(SCRIP_stdout,'(a23)') 'Too many error messages' 320 | endif 321 | endif 322 | 323 | endif 324 | 325 | write(SCRIP_stdout,SCRIP_blankFormat) 326 | write(SCRIP_stdout,SCRIP_delimFormat) 327 | write(SCRIP_stdout,SCRIP_blankFormat) 328 | 329 | endif 330 | 331 | !----------------------------------------------------------------------- 332 | !EOC 333 | 334 | end subroutine SCRIP_ErrorPrint 335 | 336 | !*********************************************************************** 337 | 338 | end module SCRIP_ErrorMod 339 | 340 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 341 | -------------------------------------------------------------------------------- /SCRIP/source/SCRIP_IOUnitsMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | module SCRIP_IOUnitsMod 4 | 5 | !BOP 6 | ! 7 | ! !MODULE: SCRIP_IOUnitsMod 8 | ! 9 | ! !DESCRIPTION: 10 | ! This module contains an I/O unit manager for tracking, assigning 11 | ! and reserving I/O unit numbers. 12 | ! 13 | ! There are three reserved I/O units set as parameters in this 14 | ! module. The default units for standard input (stdin), standard 15 | ! output (stdout) and standard error (stderr). These are currently 16 | ! set as units 5,6,6, respectively as that is the most commonly 17 | ! used among vendors. However, the user may change these if those 18 | ! default units are conflicting with other models or if the 19 | ! vendor is using different values. 20 | ! 21 | ! The maximum number of I/O units per node is currently set by 22 | ! the parameter SCRIP\_IOMaxUnits. 23 | ! 24 | ! !REFDOC: 25 | ! 26 | ! !REVISION HISTORY: 27 | ! SVN:$Id: SCRIP_IOUnitsMod.F90 83 2008-02-22 17:26:54Z pwjones $ 28 | 29 | ! !USES: 30 | 31 | use SCRIP_KindsMod 32 | 33 | implicit none 34 | private 35 | save 36 | 37 | ! !PUBLIC MEMBER FUNCTIONS: 38 | 39 | public :: SCRIP_IOUnitsGet, & 40 | SCRIP_IOUnitsRelease, & 41 | SCRIP_IOUnitsReserve, & 42 | SCRIP_IOUnitsRedirect, & 43 | SCRIP_IOUnitsFlush 44 | 45 | ! !PUBLIC DATA MEMBERS: 46 | 47 | integer (SCRIP_i4), parameter, public :: & 48 | SCRIP_stdin = 5, &! reserved unit for standard input 49 | SCRIP_stdout = 6, &! reserved unit for standard output 50 | SCRIP_stderr = 6 ! reserved unit for standard error 51 | 52 | ! common formats for writing to stdout, stderr 53 | 54 | character (9), parameter, public :: & 55 | SCRIP_delimFormat = "(72('-'))" 56 | 57 | character (5), parameter, public :: & 58 | SCRIP_blankFormat = "(' ')" 59 | 60 | !EOP 61 | !BOC 62 | !----------------------------------------------------------------------- 63 | ! 64 | ! private io unit manager variables 65 | ! 66 | !----------------------------------------------------------------------- 67 | 68 | integer (SCRIP_i4), parameter :: & 69 | SCRIP_IOUnitsMinUnits = 11, & ! do not use unit numbers below this 70 | SCRIP_IOUnitsMaxUnits = 99 ! maximum number of open units 71 | 72 | logical (SCRIP_Logical) :: & 73 | SCRIP_IOUnitsInitialized = .false. 74 | 75 | logical (SCRIP_Logical), dimension(SCRIP_IOUnitsMaxUnits) :: & 76 | SCRIP_IOUnitsInUse ! flag=.true. if unit currently open 77 | 78 | !EOC 79 | !*********************************************************************** 80 | 81 | contains 82 | 83 | !*********************************************************************** 84 | !BOP 85 | ! !IROUTINE: SCRIP_IOUnitsGet 86 | ! !INTERFACE: 87 | 88 | subroutine SCRIP_IOUnitsGet(iunit) 89 | 90 | ! !DESCRIPTION: 91 | ! This routine returns the next available i/o unit and marks it as 92 | ! in use to prevent any later use. 93 | ! Note that {\em all} processors must call this routine even if only 94 | ! the master task is doing the i/o. This is necessary insure that 95 | ! the units remain synchronized for other parallel I/O functions. 96 | ! 97 | ! !REVISION HISTORY: 98 | ! same as module 99 | 100 | ! !OUTPUT PARAMETERS: 101 | 102 | integer (SCRIP_i4), intent(out) :: & 103 | iunit ! next free i/o unit 104 | 105 | !EOP 106 | !BOC 107 | !----------------------------------------------------------------------- 108 | ! 109 | ! local variables 110 | ! 111 | !----------------------------------------------------------------------- 112 | 113 | integer (SCRIP_i4) :: n ! dummy loop index 114 | 115 | logical (SCRIP_Logical) :: alreadyInUse 116 | 117 | !----------------------------------------------------------------------- 118 | ! 119 | ! check to see if units initialized and initialize if necessary 120 | ! 121 | !----------------------------------------------------------------------- 122 | 123 | if (.not. SCRIP_IOUnitsInitialized) then 124 | SCRIP_IOUnitsInUse = .false. 125 | SCRIP_IOUnitsInUse(SCRIP_stdin) = .true. 126 | SCRIP_IOUnitsInUse(SCRIP_stdout) = .true. 127 | SCRIP_IOUnitsInUse(SCRIP_stderr) = .true. 128 | 129 | SCRIP_IOUnitsInitialized = .true. 130 | endif 131 | 132 | !----------------------------------------------------------------------- 133 | ! 134 | ! find next free unit 135 | ! 136 | !----------------------------------------------------------------------- 137 | 138 | srch_units: do n=SCRIP_IOUnitsMinUnits, SCRIP_IOUnitsMaxUnits 139 | if (.not. SCRIP_IOUnitsInUse(n)) then ! I found one, I found one 140 | 141 | !*** make sure not in use by library or calling routines 142 | INQUIRE (unit=n,OPENED=alreadyInUse) 143 | 144 | if (.not. alreadyInUse) then 145 | iunit = n ! return the free unit number 146 | SCRIP_IOUnitsInUse(iunit) = .true. ! mark iunit as being in use 147 | exit srch_units 148 | else 149 | !*** if inquire shows this unit in use, mark it as 150 | !*** in use to prevent further queries 151 | SCRIP_IOUnitsInUse(n) = .true. 152 | endif 153 | endif 154 | end do srch_units 155 | 156 | if (iunit > SCRIP_IOUnitsMaxUnits) & 157 | stop 'SCRIP_IOUnitsGet: No free units' 158 | 159 | !----------------------------------------------------------------------- 160 | !EOC 161 | 162 | end subroutine SCRIP_IOUnitsGet 163 | 164 | !*********************************************************************** 165 | !BOP 166 | ! !IROUTINE: SCRIP_IOUnitsRelease 167 | ! !INTERFACE: 168 | 169 | subroutine SCRIP_IOUnitsRelease(iunit) 170 | 171 | ! !DESCRIPTION: 172 | ! This routine releases an i/o unit (marks it as available). 173 | ! Note that {\em all} processors must call this routine even if only 174 | ! the master task is doing the i/o. This is necessary insure that 175 | ! the units remain synchronized for other parallel I/O functions. 176 | ! 177 | ! !REVISION HISTORY: 178 | ! same as module 179 | 180 | ! !INPUT PARAMETER: 181 | 182 | integer (SCRIP_i4), intent(in) :: & 183 | iunit ! i/o unit to be released 184 | 185 | !EOP 186 | !BOC 187 | !----------------------------------------------------------------------- 188 | ! 189 | ! check for proper unit number 190 | ! 191 | !----------------------------------------------------------------------- 192 | 193 | if (iunit < 1 .or. iunit > SCRIP_IOUnitsMaxUnits) then 194 | stop 'SCRIP_IOUnitsRelease: bad unit' 195 | endif 196 | 197 | !----------------------------------------------------------------------- 198 | ! 199 | ! mark the unit as not in use 200 | ! 201 | !----------------------------------------------------------------------- 202 | 203 | SCRIP_IOUnitsInUse(iunit) = .false. ! that was easy... 204 | 205 | !----------------------------------------------------------------------- 206 | !EOC 207 | 208 | end subroutine SCRIP_IOUnitsRelease 209 | 210 | !*********************************************************************** 211 | !BOP 212 | ! !IROUTINE: SCRIP_IOUnitsReserve 213 | ! !INTERFACE: 214 | 215 | subroutine SCRIP_IOUnitsReserve(iunit) 216 | 217 | ! !DESCRIPTION: 218 | ! This routine marks an IO unit as in use to reserve its use 219 | ! for purposes outside of SCRIP IO. This is necessary for 220 | ! cases where you might be importing code developed elsewhere 221 | ! that performs its own I/O and open/closes units. 222 | ! Note that {\em all} processors must call this routine even if only 223 | ! the master task is doing the i/o. This is necessary insure that 224 | ! the units remains synchronized for other parallel I/O functions. 225 | ! 226 | ! !REVISION HISTORY: 227 | ! same as module 228 | 229 | ! !INPUT PARAMETER: 230 | 231 | integer (SCRIP_i4), intent(in) :: & 232 | iunit ! i/o unit to be reserved 233 | 234 | !EOP 235 | !BOC 236 | !----------------------------------------------------------------------- 237 | ! 238 | ! local variables 239 | ! 240 | !----------------------------------------------------------------------- 241 | 242 | logical (SCRIP_Logical) :: alreadyInUse 243 | 244 | !----------------------------------------------------------------------- 245 | ! 246 | ! check for proper unit number 247 | ! 248 | !----------------------------------------------------------------------- 249 | 250 | if (iunit < SCRIP_IOUnitsMinUnits .or. & 251 | iunit > SCRIP_IOUnitsMaxUnits) then 252 | stop 'SCRIP_IOUnitsReserve: invalid unit' 253 | endif 254 | 255 | !----------------------------------------------------------------------- 256 | ! 257 | ! check to see if SCRIP already using this unit 258 | ! 259 | !----------------------------------------------------------------------- 260 | 261 | if (SCRIP_IOUnitsInUse(iunit)) then 262 | stop 'SCRIP_IOUnitsReserve: unit already in use by SCRIP' 263 | endif 264 | 265 | !----------------------------------------------------------------------- 266 | ! 267 | ! check to see if others already using this unit 268 | ! 269 | !----------------------------------------------------------------------- 270 | 271 | INQUIRE (unit=iunit, OPENED=alreadyInUse) 272 | if (alreadyInUse) then 273 | stop 'SCRIP_IOUnitsReserve: unit already in use by others' 274 | endif 275 | 276 | !----------------------------------------------------------------------- 277 | ! 278 | ! mark the unit as in use 279 | ! 280 | !----------------------------------------------------------------------- 281 | 282 | SCRIP_IOUnitsInUse(iunit) = .true. 283 | 284 | !----------------------------------------------------------------------- 285 | !EOC 286 | 287 | end subroutine SCRIP_IOUnitsReserve 288 | 289 | !*********************************************************************** 290 | !BOP 291 | ! !IROUTINE: SCRIP_IOUnitsRedirect 292 | ! !INTERFACE: 293 | 294 | subroutine SCRIP_IOUnitsRedirect(iunit, filename) 295 | 296 | ! !DESCRIPTION: 297 | ! This routine enables a user to redirect stdin, stdout, stderr to 298 | ! a file instead of to the terminal. It is only permitted for these 299 | ! special units. The SCRIP IO file operators should be used for 300 | ! normal I/O. 301 | ! Note that {\em all} processors must call this routine even if only 302 | ! the master task is doing the i/o. This is necessary insure that 303 | ! the units remains synchronized for other parallel I/O functions. 304 | ! 305 | ! !REVISION HISTORY: 306 | ! same as module 307 | 308 | ! !INPUT PARAMETER: 309 | 310 | integer (SCRIP_i4), intent(in) :: & 311 | iunit ! i/o unit to be redirected to file 312 | 313 | character (*), intent(in) :: & 314 | filename ! filename, including path, to which 315 | ! i/o should be directed 316 | 317 | !EOP 318 | !BOC 319 | !----------------------------------------------------------------------- 320 | ! 321 | ! check for proper unit number and open file 322 | ! 323 | !----------------------------------------------------------------------- 324 | 325 | if (iunit == SCRIP_stdin) then ! open input file for stdin 326 | open(unit=iunit, file=filename, status='old', form='formatted') 327 | 328 | else if (iunit == SCRIP_stdout) then ! open output file for stdout 329 | open(unit=iunit, file=filename, status='unknown', form='formatted') 330 | 331 | else if (iunit == SCRIP_stderr .and. SCRIP_stderr /= SCRIP_stdout) then 332 | ! open output file for stderr 333 | open(unit=iunit, file=filename, status='unknown', form='formatted') 334 | 335 | else 336 | stop 'SCRIP_IOUnitsRedirect: invalid unit' 337 | 338 | endif 339 | 340 | !----------------------------------------------------------------------- 341 | !EOC 342 | 343 | end subroutine SCRIP_IOUnitsRedirect 344 | 345 | !*********************************************************************** 346 | !BOP 347 | ! !IROUTINE: SCRIP_IOUnitsFlush 348 | ! !INTERFACE: 349 | 350 | subroutine SCRIP_IOUnitsFlush(iunit) 351 | 352 | ! !DESCRIPTION: 353 | ! This routine enables a user to flush the output from an IO unit 354 | ! (typically stdout) to force output when the system is buffering 355 | ! such output. Because this system function is system dependent, 356 | ! we only support this wrapper and users are welcome to insert the 357 | ! code relevant to their local machine. 358 | ! 359 | ! !REVISION HISTORY: 360 | ! same as module 361 | 362 | ! !INPUT PARAMETER: 363 | 364 | integer (SCRIP_i4), intent(in) :: & 365 | iunit ! i/o unit to be flushed 366 | 367 | !EOP 368 | !BOC 369 | !----------------------------------------------------------------------- 370 | ! 371 | ! insert your system code here 372 | ! 373 | !----------------------------------------------------------------------- 374 | 375 | !----------------------------------------------------------------------- 376 | !EOC 377 | 378 | end subroutine SCRIP_IOUnitsFlush 379 | 380 | !*********************************************************************** 381 | 382 | end module SCRIP_IOUnitsMod 383 | 384 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 385 | -------------------------------------------------------------------------------- /SCRIP/source/SCRIP_InitMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | module SCRIP_InitMod 4 | 5 | !BOP 6 | ! !MODULE: SCRIP_InitMod 7 | ! !DESCRIPTION: 8 | ! This module initializes various modules and variables needed by 9 | ! the SCRIP package. It should be call once before any other SCRIP 10 | ! routines. 11 | ! 12 | ! Users should not need to change any values in this module. 13 | ! The module performs initialization primarily by calling other 14 | ! initialization routines for each individual module in SCRIP. 15 | ! 16 | ! !REVISION HISTORY: 17 | ! SVN:$Id: $ 18 | ! 19 | ! !USES: 20 | 21 | use SCRIP_KindsMod 22 | use SCRIP_CommMod 23 | use SCRIP_ErrorMod 24 | 25 | implicit none 26 | private 27 | save 28 | 29 | ! !PUBLIC MEMBER FUNCTIONS: 30 | 31 | public :: SCRIP_Initialize 32 | 33 | !EOP 34 | !BOC 35 | !EOC 36 | !*********************************************************************** 37 | 38 | contains 39 | 40 | !*********************************************************************** 41 | !BOP 42 | ! !IROUTINE: SCRIP_Initialize -- initializes all SCRIP modules 43 | ! !INTERFACE: 44 | 45 | subroutine SCRIP_Initialize(errorCode) 46 | 47 | ! !DESCRIPTION: 48 | ! This routine initializes all modules and variables in the SCRIP 49 | ! package by calling all necessary initialization routines. 50 | ! 51 | ! !REVISION HISTORY: 52 | ! same as module 53 | 54 | ! !OUTPUT PARAMETERS: 55 | 56 | integer (SCRIP_i4), intent(out) :: & 57 | errorCode ! returned error code 58 | 59 | !EOP 60 | !BOC 61 | !----------------------------------------------------------------------- 62 | ! 63 | ! local variables 64 | ! 65 | !----------------------------------------------------------------------- 66 | 67 | character (16), parameter :: rtnName = 'SCRIP_Initialize' 68 | 69 | !----------------------------------------------------------------------- 70 | ! 71 | ! initialize by calling any required initialization routines 72 | ! 73 | !----------------------------------------------------------------------- 74 | 75 | errorCode = SCRIP_Success 76 | 77 | call SCRIP_CommInit 78 | 79 | !----------------------------------------------------------------------- 80 | !EOC 81 | 82 | end subroutine SCRIP_Initialize 83 | 84 | !*********************************************************************** 85 | 86 | end module SCRIP_InitMod 87 | 88 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 89 | -------------------------------------------------------------------------------- /SCRIP/source/SCRIP_KindsMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | module SCRIP_KindsMod 4 | 5 | !BOP 6 | ! !MODULE: SCRIP_KindsMod 7 | ! 8 | ! !DESCRIPTION: 9 | ! This module defines default numerical data types for all common data 10 | ! types like integer, character, logical, real4 and real8. 11 | ! 12 | ! !USERDOC: 13 | ! Users should not need to adjust anything in this module. If various 14 | ! character strings like long paths to files exceed the default 15 | ! character length, the default value may be increased. 16 | ! 17 | ! !REFDOC: 18 | ! This module is supplied to provide consistent data representation 19 | ! across machine architectures. It is meant to replace the old 20 | ! Fortran double precision and real *X declarations that were 21 | ! implementation-specific. 22 | ! Users should not need to adjust anything in this module. If various 23 | ! character strings like long paths to files exceed the default 24 | ! character length, the default value may be increased. 25 | ! 26 | ! !REVISION HISTORY: 27 | ! SVN:$Id: SCRIP_KindsMod.F90 82 2008-02-14 19:36:07Z pwjones $ 28 | 29 | ! !USES: 30 | ! uses no other modules 31 | 32 | implicit none 33 | private 34 | save 35 | 36 | ! !DEFINED PARAMETERS: 37 | 38 | integer, parameter, public :: & 39 | SCRIP_CharLength = 100 ,& 40 | SCRIP_Logical = kind(.true.) ,& 41 | SCRIP_i4 = selected_int_kind(6) ,& 42 | SCRIP_i8 = selected_int_kind(13) ,& 43 | SCRIP_r4 = selected_real_kind(6) ,& 44 | SCRIP_r8 = selected_real_kind(13) ,& 45 | SCRIP_r16 = selected_real_kind(26) 46 | 47 | !EOP 48 | !BOC 49 | !EOC 50 | !*********************************************************************** 51 | 52 | end module SCRIP_KindsMod 53 | 54 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 55 | -------------------------------------------------------------------------------- /SCRIP/source/SCRIP_NetcdfMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | 3 | module SCRIP_NetCDFMod 4 | 5 | !BOP 6 | ! !MODULE: SCRIP_NetCDFMod 7 | ! 8 | ! !DESCRIPTION: 9 | ! This module contains netCDF error handling functions and the 10 | ! use of the netCDF module for all netCDF functions. 11 | ! 12 | ! !REVISION HISTORY: 13 | ! SVN:$Id: $ 14 | ! 15 | ! !USES: 16 | 17 | use SCRIP_KindsMod 18 | use SCRIP_ErrorMod 19 | use netcdf 20 | 21 | implicit none 22 | private 23 | save 24 | 25 | ! !DEFINED PARAMETERS: 26 | 27 | ! !PUBLIC MEMBER FUNCTIONS: 28 | 29 | public :: SCRIP_NetcdfErrorCheck 30 | 31 | !EOP 32 | !BOC 33 | !EOC 34 | !*********************************************************************** 35 | 36 | contains 37 | 38 | !*********************************************************************** 39 | !BOP 40 | ! !IROUTINE: SCRIP_NetcdfErrorCheck 41 | ! !INTERFACE: 42 | 43 | function SCRIP_NetcdfErrorCheck(netcdfStat, errorCode, rtnName, & 44 | errorMsg) 45 | 46 | ! !DESCRIPTION: 47 | ! This routine checks netCDF status flags from netCDF routines. 48 | ! On error, it adds an error message to the error log and returns 49 | ! both a true value to the calling routines as well as setting the 50 | ! error code to fail. It is used in the same manner is the 51 | ! SCRIP\_ErrorCheck function. 52 | ! 53 | ! !REVISION HISTORY: 54 | ! same as module 55 | 56 | ! !OUTPUT PARAMETERS: 57 | 58 | logical (SCRIP_logical) :: & 59 | SCRIP_NetcdfErrorCheck 60 | 61 | integer (SCRIP_i4), intent(out) :: & 62 | errorCode ! returned SCRIP error flag 63 | 64 | ! !INPUT PARAMETERS: 65 | 66 | integer (SCRIP_i4), intent(in) :: & 67 | netcdfStat ! status flag from netCDF call 68 | 69 | character (*), intent(in) :: & 70 | rtnName, &! name of calling routine 71 | errorMsg ! error message for logging 72 | 73 | !EOP 74 | !BOC 75 | !----------------------------------------------------------------------- 76 | ! 77 | ! local variables 78 | ! 79 | !----------------------------------------------------------------------- 80 | 81 | character (SCRIP_charLength) :: & 82 | ncErrMsg ! netCDF error message 83 | 84 | !----------------------------------------------------------------------- 85 | ! 86 | ! if no error, return false and a successful errorCode 87 | ! 88 | !----------------------------------------------------------------------- 89 | 90 | if (netcdfStat == NF90_NOERR) then 91 | errorCode = SCRIP_Success 92 | SCRIP_NetcdfErrorCheck = .false. 93 | 94 | !----------------------------------------------------------------------- 95 | ! 96 | ! if an error is detected, return a true value and call the SCRIP 97 | ! error handlers to log the error. Log both the netCDF error msg 98 | ! as well as the error passed by the calling routine. 99 | ! 100 | !----------------------------------------------------------------------- 101 | 102 | else 103 | 104 | SCRIP_NetcdfErrorCheck = .true. 105 | ncErrMsg = nf90_strerror(netcdfStat) 106 | call SCRIP_ErrorSet(errorCode, rtnName, ncErrMsg) 107 | call SCRIP_ErrorSet(errorCode, rtnName, errorMsg) 108 | 109 | endif 110 | 111 | !----------------------------------------------------------------------- 112 | !EOC 113 | 114 | end function SCRIP_NetcdfErrorCheck 115 | 116 | !*********************************************************************** 117 | 118 | end module SCRIP_NetCDFMod 119 | 120 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 121 | -------------------------------------------------------------------------------- /SCRIP/source/constants.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! This module defines common constants used in many routines. 4 | ! 5 | !----------------------------------------------------------------------- 6 | ! 7 | ! CVS:$Id: constants.f,v 1.2 2000/04/19 21:56:25 pwjones Exp $ 8 | ! 9 | ! Copyright (c) 1997, 1998 the Regents of the University of 10 | ! California. 11 | ! 12 | ! This software and ancillary information (herein called software) 13 | ! called SCRIP is made available under the terms described here. 14 | ! The software has been approved for release with associated 15 | ! LA-CC Number 98-45. 16 | ! 17 | ! Unless otherwise indicated, this software has been authored 18 | ! by an employee or employees of the University of California, 19 | ! operator of the Los Alamos National Laboratory under Contract 20 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 21 | ! Government has rights to use, reproduce, and distribute this 22 | ! software. The public may copy and use this software without 23 | ! charge, provided that this Notice and any statement of authorship 24 | ! are reproduced on all copies. Neither the Government nor the 25 | ! University makes any warranty, express or implied, or assumes 26 | ! any liability or responsibility for the use of this software. 27 | ! 28 | ! If software is modified to produce derivative works, such modified 29 | ! software should be clearly marked, so as not to confuse it with 30 | ! the version available from Los Alamos National Laboratory. 31 | ! 32 | !*********************************************************************** 33 | 34 | module constants 35 | 36 | !----------------------------------------------------------------------- 37 | 38 | use SCRIP_KindsMod ! defines common data types 39 | 40 | implicit none 41 | 42 | save 43 | 44 | !----------------------------------------------------------------------- 45 | 46 | real (kind = SCRIP_r8), parameter :: 47 | & zero = 0.0_SCRIP_r8, 48 | & one = 1.0_SCRIP_r8, 49 | & two = 2.0_SCRIP_r8, 50 | & three = 3.0_SCRIP_r8, 51 | & four = 4.0_SCRIP_r8, 52 | & five = 5.0_SCRIP_r8, 53 | & half = 0.5_SCRIP_r8, 54 | & quart = 0.25_SCRIP_r8, 55 | & bignum = 1.e+20_SCRIP_r8, 56 | & tiny = 1.e-14_SCRIP_r8, 57 | & pi = 3.14159265359_SCRIP_r8, 58 | & pi2 = two*pi, 59 | & pih = half*pi 60 | 61 | !----------------------------------------------------------------------- 62 | 63 | end module constants 64 | 65 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 66 | -------------------------------------------------------------------------------- /SCRIP/source/copyright: -------------------------------------------------------------------------------- 1 | !----------------------------------------------------------------------- 2 | ! 3 | ! Copyright (c) 1997, 1998 the Regents of the University of 4 | ! California. 5 | ! 6 | ! This software and ancillary information (herein called software) 7 | ! called SCRIP is made available under the terms described here. 8 | ! The software has been approved for release with associated 9 | ! LA-CC Number 98-45. 10 | ! 11 | ! Unless otherwise indicated, this software has been authored 12 | ! by an employee or employees of the University of California, 13 | ! operator of the Los Alamos National Laboratory under Contract 14 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 15 | ! Government has rights to use, reproduce, and distribute this 16 | ! software. The public may copy and use this software without 17 | ! charge, provided that this Notice and any statement of authorship 18 | ! are reproduced on all copies. Neither the Government nor the 19 | ! University makes any warranty, express or implied, or assumes 20 | ! any liability or responsibility for the use of this software. 21 | ! 22 | ! If software is modified to produce derivative works, such modified 23 | ! software should be clearly marked, so as not to confuse it with 24 | ! the version available from Los Alamos National Laboratory. 25 | ! 26 | !----------------------------------------------------------------------- 27 | -------------------------------------------------------------------------------- /SCRIP/source/mpi/SCRIP_CommMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | !BOP 3 | 4 | module SCRIP_CommMod 5 | 6 | ! !MODULE: SCRIP_CommMod 7 | ! !DESCRIPTION: 8 | ! This module contains necessary routines and variables to support 9 | ! other parallel communication modules in SCRIP. In particular, this 10 | ! module contains communicators, tags, task ids and other necessary 11 | ! information and the routines to set them up. In addition, several 12 | ! utility routines for setting up the communication environment are 13 | ! included. 14 | ! 15 | ! !REVISION HISTORY: 16 | ! SVN:$Id: $ 17 | ! 18 | ! !USES: 19 | 20 | use SCRIP_KindsMod 21 | 22 | implicit none 23 | private 24 | save 25 | 26 | include 'mpif.h' 27 | 28 | ! !PUBLIC MEMBER FUNCTIONS: 29 | 30 | public :: SCRIP_CommInit, & 31 | SCRIP_CommInitMessageEnvironment, & 32 | SCRIP_CommExitMessageEnvironment, & 33 | SCRIP_CommAbortMessageEnvironment, & 34 | SCRIP_CommGetNumProcs, & 35 | SCRIP_CommCreateCommunicator 36 | 37 | ! !PUBLIC DATA MEMBERS: 38 | 39 | integer (SCRIP_i4), public :: & 40 | SCRIP_communicator, &! MPI communicator for ocn comms 41 | SCRIP_mpiR16, &! MPI type for r16 42 | SCRIP_mpiR8, &! MPI type for r8 43 | SCRIP_mpiR4, &! MPI type for r4 44 | SCRIP_myTask, &! MPI task number for this task 45 | SCRIP_masterTask ! MPI task number for master task 46 | 47 | !EOP 48 | !BOC 49 | !EOC 50 | !*********************************************************************** 51 | 52 | contains 53 | 54 | !*********************************************************************** 55 | !BOP 56 | ! !IROUTINE: SCRIP_CommInit 57 | ! !INTERFACE: 58 | 59 | subroutine SCRIP_CommInit 60 | 61 | ! !DESCRIPTION: 62 | ! This routine sets up default SCRIP communicator and data types. 63 | ! 64 | ! !REVISION HISTORY: 65 | ! same as module 66 | 67 | !EOP 68 | !BOC 69 | !----------------------------------------------------------------------- 70 | ! 71 | ! local variables 72 | ! 73 | !----------------------------------------------------------------------- 74 | 75 | integer (SCRIP_i4) :: ierr ! MPI error flag 76 | 77 | !----------------------------------------------------------------------- 78 | ! 79 | ! create communicator for internal SCRIP communications 80 | ! Generally, it inherits the default MPI communicator from the 81 | ! calling routine. It is assumed that the MPI initialization occurs 82 | ! within the calling application or that 83 | ! SCRIP\_CommInitMessageEnvironment is called from the driver routine. 84 | ! 85 | !----------------------------------------------------------------------- 86 | 87 | !----------------------------------------------------------------------- 88 | ! 89 | ! when not coupled, simply duplicate global communicator 90 | ! 91 | !----------------------------------------------------------------------- 92 | 93 | call MPI_COMM_DUP(MPI_COMM_WORLD, SCRIP_communicator, ierr) 94 | 95 | !----------------------------------------------------------------------- 96 | ! 97 | ! determine task ids 98 | ! 99 | !----------------------------------------------------------------------- 100 | 101 | SCRIP_masterTask = 0 102 | call MPI_COMM_RANK (SCRIP_communicator, SCRIP_myTask, ierr) 103 | 104 | !----------------------------------------------------------------------- 105 | ! 106 | ! On some machines the MPI implementation makes some assumptions about 107 | ! these data types, so these are chosen to try and choose the 108 | ! appropriate kind. 109 | ! 110 | !----------------------------------------------------------------------- 111 | 112 | SCRIP_mpiR16 = MPI_REAL16 113 | SCRIP_mpiR8 = MPI_REAL8 114 | SCRIP_mpiR4 = MPI_REAL4 115 | 116 | !----------------------------------------------------------------------- 117 | !EOC 118 | 119 | end subroutine SCRIP_CommInit 120 | 121 | !*********************************************************************** 122 | !BOP 123 | ! !IROUTINE: SCRIP_CommGetNumProcs 124 | ! !INTERFACE: 125 | 126 | function SCRIP_CommGetNumProcs(communicator) 127 | 128 | ! !DESCRIPTION: 129 | ! This function returns the number of processor assigned to 130 | ! a given communicator. 131 | ! 132 | ! !REVISION HISTORY: 133 | ! same as module 134 | 135 | ! !INPUT PARAMETERS: 136 | 137 | integer (SCRIP_i4), intent(in) :: & 138 | communicator ! communicator to query for num processors 139 | 140 | ! !OUTPUT PARAMETERS: 141 | 142 | integer (SCRIP_i4) :: & 143 | SCRIP_CommGetNumProcs ! number of processors in communicator 144 | 145 | !EOP 146 | !BOC 147 | !----------------------------------------------------------------------- 148 | ! 149 | ! local variables 150 | ! 151 | !----------------------------------------------------------------------- 152 | 153 | integer (SCRIP_i4) :: ierr 154 | 155 | !----------------------------------------------------------------------- 156 | 157 | call MPI_COMM_SIZE(communicator, SCRIP_CommGetNumProcs, ierr) 158 | 159 | !----------------------------------------------------------------------- 160 | !EOC 161 | 162 | end function SCRIP_CommGetNumProcs 163 | 164 | !*********************************************************************** 165 | !BOP 166 | ! !IROUTINE: SCRIP_CommInitMessageEnvironment 167 | ! !INTERFACE: 168 | 169 | subroutine SCRIP_CommInitMessageEnvironment 170 | 171 | ! !DESCRIPTION: 172 | ! This routine initializes the message environment. 173 | ! 174 | ! !REVISION HISTORY: 175 | ! same as module 176 | 177 | ! !INCLUDES: 178 | 179 | !EOP 180 | !BOC 181 | !----------------------------------------------------------------------- 182 | ! 183 | ! local variables 184 | ! 185 | !----------------------------------------------------------------------- 186 | 187 | integer (SCRIP_i4) :: ierr ! MPI error flag 188 | 189 | !----------------------------------------------------------------------- 190 | 191 | call MPI_INIT(ierr) 192 | call MPI_BARRIER(MPI_COMM_WORLD,ierr) 193 | 194 | !----------------------------------------------------------------------- 195 | !EOC 196 | 197 | end subroutine SCRIP_CommInitMessageEnvironment 198 | 199 | !*********************************************************************** 200 | !BOP 201 | ! !IROUTINE: SCRIP_CommExitMessageEnvironment 202 | ! !INTERFACE: 203 | 204 | subroutine SCRIP_CommExitMessageEnvironment 205 | 206 | ! !DESCRIPTION: 207 | ! This routine exits the message environment properly when model 208 | ! stops. 209 | ! 210 | ! !REVISION HISTORY: 211 | ! same as module 212 | 213 | ! !INCLUDES: 214 | 215 | !EOP 216 | !BOC 217 | !----------------------------------------------------------------------- 218 | ! 219 | ! local variables 220 | ! 221 | !----------------------------------------------------------------------- 222 | 223 | integer (SCRIP_i4) :: ierr ! MPI error flag 224 | 225 | !----------------------------------------------------------------------- 226 | 227 | call MPI_FINALIZE(ierr) 228 | 229 | !----------------------------------------------------------------------- 230 | !EOC 231 | 232 | end subroutine SCRIP_CommExitMessageEnvironment 233 | 234 | !*********************************************************************** 235 | !BOP 236 | ! !IROUTINE: SCRIP_CommAbortMessageEnvironment 237 | ! !INTERFACE: 238 | 239 | subroutine SCRIP_CommAbortMessageEnvironment 240 | 241 | ! !DESCRIPTION: 242 | ! This routine aborts the message environment when model stops. 243 | ! It will attempt to abort the entire MPI COMM WORLD. 244 | ! 245 | ! !REVISION HISTORY: 246 | ! same as module 247 | 248 | ! !INCLUDES: 249 | 250 | !EOP 251 | !BOC 252 | !----------------------------------------------------------------------- 253 | ! 254 | ! local variables 255 | ! 256 | !----------------------------------------------------------------------- 257 | 258 | integer (SCRIP_i4) :: errorCode, ierr !MPI error flag 259 | 260 | !----------------------------------------------------------------------- 261 | 262 | call MPI_BARRIER(SCRIP_Communicator, ierr) 263 | call MPI_ABORT(MPI_COMM_WORLD, errorCode, ierr) 264 | call MPI_FINALIZE(ierr) 265 | 266 | !----------------------------------------------------------------------- 267 | !EOC 268 | 269 | end subroutine SCRIP_CommAbortMessageEnvironment 270 | 271 | !*********************************************************************** 272 | !BOP 273 | ! !IROUTINE: SCRIP_CommCreateCommunicator 274 | ! !INTERFACE: 275 | 276 | subroutine SCRIP_CommCreateCommunicator(newCommunicator, numProcs) 277 | 278 | ! !DESCRIPTION: 279 | ! This routine creates a separate communicator for a subset of 280 | ! processors under default SCRIP communicator. 281 | ! 282 | ! !REVISION HISTORY: 283 | ! same as module 284 | 285 | ! !INCLUDES: 286 | 287 | ! !INPUT PARAMETERS: 288 | 289 | integer (SCRIP_i4), intent(in) :: & 290 | numProcs ! num of procs in new distribution 291 | 292 | ! !OUTPUT PARAMETERS: 293 | 294 | integer (SCRIP_i4), intent(out) :: & 295 | newCommunicator ! new communicator for this distribution 296 | 297 | !EOP 298 | !BOC 299 | !----------------------------------------------------------------------- 300 | ! 301 | ! local variables 302 | ! 303 | !----------------------------------------------------------------------- 304 | 305 | integer (SCRIP_i4) :: & 306 | MPI_GROUP_OCN, &! group of processors assigned to ocn 307 | MPI_GROUP_NEW ! group of processors assigned to new dist 308 | 309 | integer (SCRIP_i4) :: & 310 | ierr ! error flag for MPI comms 311 | 312 | integer (SCRIP_i4), dimension(3) :: & 313 | range ! range of tasks assigned to new dist 314 | ! (assumed 0,num_procs-1) 315 | 316 | !----------------------------------------------------------------------- 317 | ! 318 | ! determine group of processes assigned to distribution 319 | ! 320 | !----------------------------------------------------------------------- 321 | 322 | call MPI_COMM_GROUP (SCRIP_Communicator, MPI_GROUP_OCN, ierr) 323 | 324 | range(1) = 0 325 | range(2) = numProcs-1 326 | range(3) = 1 327 | 328 | !----------------------------------------------------------------------- 329 | ! 330 | ! create subroup and communicator for new distribution 331 | ! note: MPI_COMM_CREATE must be called by all procs in SCRIP_Communicator 332 | ! 333 | !----------------------------------------------------------------------- 334 | 335 | call MPI_GROUP_RANGE_INCL(MPI_GROUP_OCN, 1, range, & 336 | MPI_GROUP_NEW, ierr) 337 | 338 | call MPI_COMM_CREATE (SCRIP_Communicator, MPI_GROUP_NEW, & 339 | newCommunicator, ierr) 340 | 341 | !----------------------------------------------------------------------- 342 | !EOC 343 | 344 | end subroutine SCRIP_CommCreateCommunicator 345 | 346 | !*********************************************************************** 347 | 348 | end module SCRIP_CommMod 349 | 350 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 351 | -------------------------------------------------------------------------------- /SCRIP/source/remap_distance_weight.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! this module contains necessary routines for performing an 4 | ! interpolation using a distance-weighted average of n nearest 5 | ! neighbors. 6 | ! 7 | !----------------------------------------------------------------------- 8 | ! 9 | ! CVS:$Id: remap_distwgt.f,v 1.3 2000/04/19 21:56:26 pwjones Exp $ 10 | ! 11 | ! Copyright (c) 1997, 1998 the Regents of the University of 12 | ! California. 13 | ! 14 | ! This software and ancillary information (herein called software) 15 | ! called SCRIP is made available under the terms described here. 16 | ! The software has been approved for release with associated 17 | ! LA-CC Number 98-45. 18 | ! 19 | ! Unless otherwise indicated, this software has been authored 20 | ! by an employee or employees of the University of California, 21 | ! operator of the Los Alamos National Laboratory under Contract 22 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 23 | ! Government has rights to use, reproduce, and distribute this 24 | ! software. The public may copy and use this software without 25 | ! charge, provided that this Notice and any statement of authorship 26 | ! are reproduced on all copies. Neither the Government nor the 27 | ! University makes any warranty, express or implied, or assumes 28 | ! any liability or responsibility for the use of this software. 29 | ! 30 | ! If software is modified to produce derivative works, such modified 31 | ! software should be clearly marked, so as not to confuse it with 32 | ! the version available from Los Alamos National Laboratory. 33 | ! 34 | !*********************************************************************** 35 | 36 | module remap_distance_weight 37 | 38 | !----------------------------------------------------------------------- 39 | 40 | use SCRIP_KindsMod ! defines common data types 41 | use constants ! defines common constants 42 | use grids ! module containing grid info 43 | use remap_vars ! module containing remap info 44 | 45 | implicit none 46 | 47 | !----------------------------------------------------------------------- 48 | ! 49 | ! module variables 50 | ! 51 | !----------------------------------------------------------------------- 52 | 53 | integer (SCRIP_i4), parameter :: 54 | & num_neighbors=4 ! num nearest neighbors to interpolate from 55 | 56 | real (SCRIP_r8), dimension(:), allocatable, save :: 57 | & coslat, sinlat, ! cosine, sine of grid lats (for distance) 58 | & coslon, sinlon, ! cosine, sine of grid lons (for distance) 59 | & wgtstmp ! an array to hold the link weight 60 | 61 | !*********************************************************************** 62 | 63 | contains 64 | 65 | !*********************************************************************** 66 | 67 | subroutine remap_distwgt 68 | 69 | !----------------------------------------------------------------------- 70 | ! 71 | ! this routine computes the inverse-distance weights for a 72 | ! nearest-neighbor interpolation. 73 | ! 74 | !----------------------------------------------------------------------- 75 | 76 | !----------------------------------------------------------------------- 77 | ! 78 | ! local variables 79 | ! 80 | !----------------------------------------------------------------------- 81 | 82 | logical (SCRIP_logical), dimension(num_neighbors) :: 83 | & nbr_mask ! mask at nearest neighbors 84 | 85 | integer (SCRIP_i4) :: n, 86 | & dst_add, ! destination address 87 | & nmap ! index of current map being computed 88 | 89 | integer (SCRIP_i4), dimension(num_neighbors) :: 90 | & nbr_add ! source address at nearest neighbors 91 | 92 | real (SCRIP_r8), dimension(num_neighbors) :: 93 | & nbr_dist ! angular distance four nearest neighbors 94 | 95 | real (SCRIP_r8) :: 96 | & coslat_dst, ! cos(lat) of destination grid point 97 | & coslon_dst, ! cos(lon) of destination grid point 98 | & sinlat_dst, ! sin(lat) of destination grid point 99 | & sinlon_dst, ! sin(lon) of destination grid point 100 | & dist_tot ! sum of neighbor distances (for normalizing) 101 | 102 | !----------------------------------------------------------------------- 103 | ! 104 | ! compute mappings from grid1 to grid2 105 | ! 106 | !----------------------------------------------------------------------- 107 | 108 | nmap = 1 109 | 110 | !*** 111 | !*** allocate wgtstmp to be consistent with store_link interface 112 | !*** 113 | 114 | allocate (wgtstmp(num_wts)) 115 | 116 | !*** 117 | !*** compute cos, sin of lat/lon on source grid for distance 118 | !*** calculations 119 | !*** 120 | 121 | allocate (coslat(grid1_size), coslon(grid1_size), 122 | & sinlat(grid1_size), sinlon(grid1_size)) 123 | 124 | coslat = cos(grid1_center_lat) 125 | coslon = cos(grid1_center_lon) 126 | sinlat = sin(grid1_center_lat) 127 | sinlon = sin(grid1_center_lon) 128 | 129 | !*** 130 | !*** loop over destination grid 131 | !*** 132 | 133 | grid_loop1: do dst_add = 1, grid2_size 134 | 135 | if (.not. grid2_mask(dst_add)) cycle grid_loop1 136 | 137 | coslat_dst = cos(grid2_center_lat(dst_add)) 138 | coslon_dst = cos(grid2_center_lon(dst_add)) 139 | sinlat_dst = sin(grid2_center_lat(dst_add)) 140 | sinlon_dst = sin(grid2_center_lon(dst_add)) 141 | 142 | !*** 143 | !*** find nearest grid points on source grid and 144 | !*** distances to each point 145 | !*** 146 | 147 | call grid_search_nbr(nbr_add, nbr_dist, 148 | & grid2_center_lat(dst_add), 149 | & grid2_center_lon(dst_add), 150 | & coslat_dst, coslon_dst, 151 | & sinlat_dst, sinlon_dst, 152 | & bin_addr1, bin_addr2) 153 | 154 | !*** 155 | !*** compute weights based on inverse distance 156 | !*** if mask is false, eliminate those points 157 | !*** 158 | 159 | dist_tot = zero 160 | do n=1,num_neighbors 161 | if (grid1_mask(nbr_add(n))) then 162 | nbr_dist(n) = one/nbr_dist(n) 163 | dist_tot = dist_tot + nbr_dist(n) 164 | nbr_mask(n) = .true. 165 | else 166 | nbr_mask(n) = .false. 167 | endif 168 | end do 169 | 170 | !*** 171 | !*** normalize weights and store the link 172 | !*** 173 | 174 | do n=1,num_neighbors 175 | if (nbr_mask(n)) then 176 | wgtstmp(1) = nbr_dist(n)/dist_tot 177 | call store_link_nbr(nbr_add(n), dst_add, wgtstmp, nmap) 178 | grid2_frac(dst_add) = one 179 | endif 180 | end do 181 | 182 | end do grid_loop1 183 | 184 | deallocate (coslat, coslon, sinlat, sinlon) 185 | 186 | !----------------------------------------------------------------------- 187 | ! 188 | ! compute mappings from grid2 to grid1 if necessary 189 | ! 190 | !----------------------------------------------------------------------- 191 | 192 | if (num_maps > 1) then 193 | 194 | nmap = 2 195 | 196 | !*** 197 | !*** compute cos, sin of lat/lon on source grid for distance 198 | !*** calculations 199 | !*** 200 | 201 | allocate (coslat(grid2_size), coslon(grid2_size), 202 | & sinlat(grid2_size), sinlon(grid2_size)) 203 | 204 | coslat = cos(grid2_center_lat) 205 | coslon = cos(grid2_center_lon) 206 | sinlat = sin(grid2_center_lat) 207 | sinlon = sin(grid2_center_lon) 208 | 209 | !*** 210 | !*** loop over destination grid 211 | !*** 212 | 213 | grid_loop2: do dst_add = 1, grid1_size 214 | 215 | if (.not. grid1_mask(dst_add)) cycle grid_loop2 216 | 217 | coslat_dst = cos(grid1_center_lat(dst_add)) 218 | coslon_dst = cos(grid1_center_lon(dst_add)) 219 | sinlat_dst = sin(grid1_center_lat(dst_add)) 220 | sinlon_dst = sin(grid1_center_lon(dst_add)) 221 | 222 | !*** 223 | !*** find four nearest grid points on source grid and 224 | !*** distances to each point 225 | !*** 226 | 227 | call grid_search_nbr(nbr_add, nbr_dist, 228 | & grid1_center_lat(dst_add), 229 | & grid1_center_lon(dst_add), 230 | & coslat_dst, coslon_dst, 231 | & sinlat_dst, sinlon_dst, 232 | & bin_addr2, bin_addr1) 233 | 234 | !*** 235 | !*** compute weights based on inverse distance 236 | !*** if mask is false, eliminate those points 237 | !*** 238 | 239 | dist_tot = zero 240 | do n=1,num_neighbors 241 | if (grid2_mask(nbr_add(n))) then 242 | nbr_dist(n) = one/nbr_dist(n) 243 | dist_tot = dist_tot + nbr_dist(n) 244 | nbr_mask(n) = .true. 245 | else 246 | nbr_mask(n) = .false. 247 | endif 248 | end do 249 | 250 | !*** 251 | !*** normalize weights and store the link 252 | !*** 253 | 254 | do n=1,num_neighbors 255 | if (nbr_mask(n)) then 256 | wgtstmp(1) = nbr_dist(n)/dist_tot 257 | call store_link_nbr(dst_add, nbr_add(n), wgtstmp, nmap) 258 | grid1_frac(dst_add) = one 259 | endif 260 | end do 261 | 262 | end do grid_loop2 263 | 264 | deallocate (coslat, coslon, sinlat, sinlon) 265 | 266 | endif 267 | 268 | deallocate(wgtstmp) 269 | 270 | !----------------------------------------------------------------------- 271 | 272 | end subroutine remap_distwgt 273 | 274 | !*********************************************************************** 275 | 276 | subroutine grid_search_nbr(nbr_add, nbr_dist, plat, plon, 277 | & coslat_dst, coslon_dst, sinlat_dst, sinlon_dst, 278 | & src_bin_add, dst_bin_add) 279 | 280 | !----------------------------------------------------------------------- 281 | ! 282 | ! this routine finds the closest num_neighbor points to a search 283 | ! point and computes a distance to each of the neighbors. 284 | ! 285 | !----------------------------------------------------------------------- 286 | 287 | !----------------------------------------------------------------------- 288 | ! 289 | ! output variables 290 | ! 291 | !----------------------------------------------------------------------- 292 | 293 | integer (SCRIP_i4), dimension(num_neighbors), intent(out) :: 294 | & nbr_add ! address of each of the closest points 295 | 296 | real (SCRIP_r8), dimension(num_neighbors), intent(out) :: 297 | & nbr_dist ! distance to each of the closest points 298 | 299 | !----------------------------------------------------------------------- 300 | ! 301 | ! input variables 302 | ! 303 | !----------------------------------------------------------------------- 304 | 305 | integer (SCRIP_i4), dimension(:,:), intent(in) :: 306 | & src_bin_add, ! search bins for restricting search 307 | & dst_bin_add 308 | 309 | real (SCRIP_r8), intent(in) :: 310 | & plat, ! latitude of the search point 311 | & plon, ! longitude of the search point 312 | & coslat_dst, ! cos(lat) of the search point 313 | & coslon_dst, ! cos(lon) of the search point 314 | & sinlat_dst, ! sin(lat) of the search point 315 | & sinlon_dst ! sin(lon) of the search point 316 | 317 | !----------------------------------------------------------------------- 318 | ! 319 | ! local variables 320 | ! 321 | !----------------------------------------------------------------------- 322 | 323 | integer (SCRIP_i4) :: n, nmax, nadd, nchk, ! dummy indices 324 | & min_add, max_add, nm1, np1, i, j, ip1, im1, jp1, jm1 325 | 326 | real (SCRIP_r8) :: 327 | & distance ! angular distance 328 | 329 | !----------------------------------------------------------------------- 330 | ! 331 | ! loop over source grid and find nearest neighbors 332 | ! 333 | !----------------------------------------------------------------------- 334 | 335 | !*** 336 | !*** restrict the search using search bins 337 | !*** expand the bins to catch neighbors 338 | !*** 339 | 340 | select case (restrict_type) 341 | case('latitude') 342 | 343 | do n=1,num_srch_bins 344 | if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n)) then 345 | min_add = src_bin_add(1,n) 346 | max_add = src_bin_add(2,n) 347 | 348 | nm1 = max(n-1,1) 349 | np1 = min(n+1,num_srch_bins) 350 | 351 | min_add = min(min_add,src_bin_add(1,nm1)) 352 | max_add = max(max_add,src_bin_add(2,nm1)) 353 | min_add = min(min_add,src_bin_add(1,np1)) 354 | max_add = max(max_add,src_bin_add(2,np1)) 355 | endif 356 | end do 357 | 358 | case('latlon') 359 | 360 | n = 0 361 | nmax = nint(sqrt(real(num_srch_bins))) 362 | do j=1,nmax 363 | jp1 = min(j+1,nmax) 364 | jm1 = max(j-1,1) 365 | do i=1,nmax 366 | ip1 = min(i+1,nmax) 367 | im1 = max(i-1,1) 368 | 369 | n = n+1 370 | if (plat >= bin_lats(1,n) .and. plat <= bin_lats(2,n) .and. 371 | & plon >= bin_lons(1,n) .and. plon <= bin_lons(3,n)) then 372 | min_add = src_bin_add(1,n) 373 | max_add = src_bin_add(2,n) 374 | 375 | nm1 = (jm1-1)*nmax + im1 376 | np1 = (jp1-1)*nmax + ip1 377 | nm1 = max(nm1,1) 378 | np1 = min(np1,num_srch_bins) 379 | 380 | min_add = min(min_add,src_bin_add(1,nm1)) 381 | max_add = max(max_add,src_bin_add(2,nm1)) 382 | min_add = min(min_add,src_bin_add(1,np1)) 383 | max_add = max(max_add,src_bin_add(2,np1)) 384 | endif 385 | end do 386 | end do 387 | 388 | end select 389 | 390 | !*** 391 | !*** initialize distance and address arrays 392 | !*** 393 | 394 | nbr_add = 0 395 | nbr_dist = bignum 396 | 397 | do nadd=min_add,max_add 398 | 399 | !*** 400 | !*** find distance to this point 401 | !*** 402 | 403 | distance = acos(sinlat_dst*sinlat(nadd) + 404 | & coslat_dst*coslat(nadd)* 405 | & (coslon_dst*coslon(nadd) + 406 | & sinlon_dst*sinlon(nadd)) ) 407 | 408 | !*** 409 | !*** store the address and distance if this is one of the 410 | !*** smallest four so far 411 | !*** 412 | 413 | check_loop: do nchk=1,num_neighbors 414 | if (distance .lt. nbr_dist(nchk)) then 415 | do n=num_neighbors,nchk+1,-1 416 | nbr_add(n) = nbr_add(n-1) 417 | nbr_dist(n) = nbr_dist(n-1) 418 | end do 419 | nbr_add(nchk) = nadd 420 | nbr_dist(nchk) = distance 421 | exit check_loop 422 | endif 423 | end do check_loop 424 | 425 | end do 426 | 427 | !----------------------------------------------------------------------- 428 | 429 | end subroutine grid_search_nbr 430 | 431 | !*********************************************************************** 432 | 433 | subroutine store_link_nbr(add1, add2, weights, nmap) 434 | 435 | !----------------------------------------------------------------------- 436 | ! 437 | ! this routine stores the address and weight for this link in 438 | ! the appropriate address and weight arrays and resizes those 439 | ! arrays if necessary. 440 | ! 441 | !----------------------------------------------------------------------- 442 | 443 | !----------------------------------------------------------------------- 444 | ! 445 | ! input variables 446 | ! 447 | !----------------------------------------------------------------------- 448 | 449 | integer (SCRIP_i4), intent(in) :: 450 | & add1, ! address on grid1 451 | & add2, ! address on grid2 452 | & nmap ! identifies which direction for mapping 453 | 454 | real (SCRIP_r8), dimension(:), intent(in) :: 455 | & weights ! array of remapping weights for this link 456 | 457 | !----------------------------------------------------------------------- 458 | ! 459 | ! increment number of links and check to see if remap arrays need 460 | ! to be increased to accomodate the new link. then store the 461 | ! link. 462 | ! 463 | !----------------------------------------------------------------------- 464 | 465 | select case (nmap) 466 | case(1) 467 | 468 | num_links_map1 = num_links_map1 + 1 469 | 470 | if (num_links_map1 > max_links_map1) 471 | & call resize_remap_vars(1,resize_increment) 472 | 473 | grid1_add_map1(num_links_map1) = add1 474 | grid2_add_map1(num_links_map1) = add2 475 | wts_map1 (:,num_links_map1) = weights 476 | 477 | case(2) 478 | 479 | num_links_map2 = num_links_map2 + 1 480 | 481 | if (num_links_map2 > max_links_map2) 482 | & call resize_remap_vars(2,resize_increment) 483 | 484 | grid1_add_map2(num_links_map2) = add1 485 | grid2_add_map2(num_links_map2) = add2 486 | wts_map2 (:,num_links_map2) = weights 487 | 488 | end select 489 | 490 | !----------------------------------------------------------------------- 491 | 492 | end subroutine store_link_nbr 493 | 494 | !*********************************************************************** 495 | 496 | end module remap_distance_weight 497 | 498 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 499 | -------------------------------------------------------------------------------- /SCRIP/source/remap_mod.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! this routine performs a remapping based on addresses and weights 4 | ! computed in a setup phase 5 | ! 6 | !----------------------------------------------------------------------- 7 | ! 8 | ! CVS:$Id: remap.f,v 1.5 2000/04/19 21:56:25 pwjones Exp $ 9 | ! 10 | ! Copyright (c) 1997, 1998 the Regents of the University of 11 | ! California. 12 | ! 13 | ! This software and ancillary information (herein called software) 14 | ! called SCRIP is made available under the terms described here. 15 | ! The software has been approved for release with associated 16 | ! LA-CC Number 98-45. 17 | ! 18 | ! Unless otherwise indicated, this software has been authored 19 | ! by an employee or employees of the University of California, 20 | ! operator of the Los Alamos National Laboratory under Contract 21 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 22 | ! Government has rights to use, reproduce, and distribute this 23 | ! software. The public may copy and use this software without 24 | ! charge, provided that this Notice and any statement of authorship 25 | ! are reproduced on all copies. Neither the Government nor the 26 | ! University makes any warranty, express or implied, or assumes 27 | ! any liability or responsibility for the use of this software. 28 | ! 29 | ! If software is modified to produce derivative works, such modified 30 | ! software should be clearly marked, so as not to confuse it with 31 | ! the version available from Los Alamos National Laboratory. 32 | ! 33 | !*********************************************************************** 34 | 35 | module remap_mod 36 | 37 | !----------------------------------------------------------------------- 38 | ! 39 | ! this module contains the routines for performing the actual 40 | ! remappings 41 | ! 42 | !----------------------------------------------------------------------- 43 | 44 | use SCRIP_KindsMod ! defines common data types 45 | use constants ! defines common constants 46 | 47 | implicit none 48 | 49 | !*********************************************************************** 50 | 51 | contains 52 | 53 | !*********************************************************************** 54 | 55 | subroutine remap(dst_array, map_wts, dst_add, src_add, 56 | & src_array, src_grad1, src_grad2, src_grad3) 57 | 58 | !----------------------------------------------------------------------- 59 | ! 60 | ! performs the remapping based on weights computed elsewhere 61 | ! 62 | !----------------------------------------------------------------------- 63 | 64 | !----------------------------------------------------------------------- 65 | ! 66 | ! input arrays 67 | ! 68 | !----------------------------------------------------------------------- 69 | 70 | integer (SCRIP_i4), dimension(:), intent(in) :: 71 | & dst_add, ! destination address for each link 72 | & src_add ! source address for each link 73 | 74 | real (SCRIP_r8), dimension(:,:), intent(in) :: 75 | & map_wts ! remapping weights for each link 76 | 77 | real (SCRIP_r8), dimension(:), intent(in) :: 78 | & src_array ! array with source field to be remapped 79 | 80 | real (SCRIP_r8), dimension(:), intent(in), optional :: 81 | & src_grad1 ! gradient arrays on source grid necessary for 82 | &, src_grad2 ! higher-order remappings 83 | &, src_grad3 84 | 85 | !----------------------------------------------------------------------- 86 | ! 87 | ! output variables 88 | ! 89 | !----------------------------------------------------------------------- 90 | 91 | real (SCRIP_r8), dimension(:), intent(inout) :: 92 | & dst_array ! array for remapped field on destination grid 93 | 94 | !----------------------------------------------------------------------- 95 | ! 96 | ! local variables 97 | ! 98 | !----------------------------------------------------------------------- 99 | 100 | integer (SCRIP_i4) :: n, iorder 101 | 102 | !----------------------------------------------------------------------- 103 | ! 104 | ! check the order of the interpolation 105 | ! 106 | !----------------------------------------------------------------------- 107 | 108 | if (present(src_grad1)) then 109 | iorder = 2 110 | else 111 | iorder = 1 112 | endif 113 | 114 | !----------------------------------------------------------------------- 115 | ! 116 | ! first order remapping 117 | ! 118 | !----------------------------------------------------------------------- 119 | 120 | dst_array = zero 121 | 122 | select case (iorder) 123 | case(1) 124 | 125 | do n=1,size(dst_add) 126 | dst_array(dst_add(n)) = dst_array(dst_add(n)) + 127 | & src_array(src_add(n))*map_wts(1,n) 128 | end do 129 | 130 | !----------------------------------------------------------------------- 131 | ! 132 | ! second order remapping 133 | ! 134 | !----------------------------------------------------------------------- 135 | 136 | case(2) 137 | 138 | if (size(map_wts,DIM=1) == 3) then 139 | do n=1,size(dst_add) 140 | dst_array(dst_add(n)) = dst_array(dst_add(n)) + 141 | & src_array(src_add(n))*map_wts(1,n) + 142 | & src_grad1(src_add(n))*map_wts(2,n) + 143 | & src_grad2(src_add(n))*map_wts(3,n) 144 | end do 145 | else if (size(map_wts,DIM=1) == 4) then 146 | do n=1,size(dst_add) 147 | dst_array(dst_add(n)) = dst_array(dst_add(n)) + 148 | & src_array(src_add(n))*map_wts(1,n) + 149 | & src_grad1(src_add(n))*map_wts(2,n) + 150 | & src_grad2(src_add(n))*map_wts(3,n) + 151 | & src_grad3(src_add(n))*map_wts(4,n) 152 | end do 153 | endif 154 | 155 | end select 156 | 157 | !----------------------------------------------------------------------- 158 | 159 | end subroutine remap 160 | 161 | !*********************************************************************** 162 | 163 | end module remap_mod 164 | 165 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 166 | -------------------------------------------------------------------------------- /SCRIP/source/remap_vars.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! this module contains necessary variables for remapping between 4 | ! two grids. also routines for resizing and initializing these 5 | ! variables. 6 | ! 7 | !----------------------------------------------------------------------- 8 | ! 9 | ! CVS:$Id: remap_vars.f,v 1.5 2000/04/19 21:56:26 pwjones Exp $ 10 | ! 11 | ! Copyright (c) 1997, 1998 the Regents of the University of 12 | ! California. 13 | ! 14 | ! This software and ancillary information (herein called software) 15 | ! called SCRIP is made available under the terms described here. 16 | ! The software has been approved for release with associated 17 | ! LA-CC Number 98-45. 18 | ! 19 | ! Unless otherwise indicated, this software has been authored 20 | ! by an employee or employees of the University of California, 21 | ! operator of the Los Alamos National Laboratory under Contract 22 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 23 | ! Government has rights to use, reproduce, and distribute this 24 | ! software. The public may copy and use this software without 25 | ! charge, provided that this Notice and any statement of authorship 26 | ! are reproduced on all copies. Neither the Government nor the 27 | ! University makes any warranty, express or implied, or assumes 28 | ! any liability or responsibility for the use of this software. 29 | ! 30 | ! If software is modified to produce derivative works, such modified 31 | ! software should be clearly marked, so as not to confuse it with 32 | ! the version available from Los Alamos National Laboratory. 33 | ! 34 | !*********************************************************************** 35 | 36 | module remap_vars 37 | 38 | use SCRIP_KindsMod ! defines common data types 39 | use constants 40 | use grids 41 | 42 | implicit none 43 | 44 | !----------------------------------------------------------------------- 45 | ! 46 | ! module variables 47 | ! 48 | !----------------------------------------------------------------------- 49 | 50 | integer (SCRIP_i4), parameter :: 51 | & norm_opt_none = 1 52 | &, norm_opt_dstarea = 2 53 | &, norm_opt_frcarea = 3 54 | 55 | integer (SCRIP_i4), parameter :: 56 | & map_type_conserv = 1 57 | &, map_type_bilinear = 2 58 | &, map_type_bicubic = 3 59 | &, map_type_distwgt = 4 60 | &, map_type_particle = 5 61 | 62 | integer (SCRIP_i4), save :: 63 | & max_links_map1 ! current size of link arrays 64 | &, num_links_map1 ! actual number of links for remapping 65 | &, max_links_map2 ! current size of link arrays 66 | &, num_links_map2 ! actual number of links for remapping 67 | &, num_maps ! num of remappings for this grid pair 68 | &, num_wts ! num of weights used in remapping 69 | &, map_type ! identifier for remapping method 70 | &, norm_opt ! option for normalization (conserv only) 71 | &, resize_increment ! default amount to increase array size 72 | 73 | integer (SCRIP_i4), dimension(:), allocatable, save :: 74 | & grid1_add_map1, ! grid1 address for each link in mapping 1 75 | & grid2_add_map1, ! grid2 address for each link in mapping 1 76 | & grid1_add_map2, ! grid1 address for each link in mapping 2 77 | & grid2_add_map2 ! grid2 address for each link in mapping 2 78 | 79 | real (SCRIP_r8), dimension(:,:), allocatable, save :: 80 | & wts_map1, ! map weights for each link (num_wts,max_links) 81 | & wts_map2 ! map weights for each link (num_wts,max_links) 82 | 83 | !*********************************************************************** 84 | 85 | contains 86 | 87 | !*********************************************************************** 88 | 89 | subroutine init_remap_vars 90 | 91 | !----------------------------------------------------------------------- 92 | ! 93 | ! this routine initializes some variables and provides an initial 94 | ! allocation of arrays (fairly large so frequent resizing 95 | ! unnecessary). 96 | ! 97 | !----------------------------------------------------------------------- 98 | 99 | !----------------------------------------------------------------------- 100 | ! 101 | ! determine the number of weights 102 | ! 103 | !----------------------------------------------------------------------- 104 | 105 | select case (map_type) 106 | case(map_type_conserv) 107 | num_wts = 3 108 | case(map_type_bilinear) 109 | num_wts = 1 110 | case(map_type_bicubic) 111 | num_wts = 4 112 | case(map_type_distwgt) 113 | num_wts = 1 114 | case(map_type_particle) 115 | num_wts = 1 116 | end select 117 | 118 | !----------------------------------------------------------------------- 119 | ! 120 | ! initialize num_links and set max_links to four times the largest 121 | ! of the destination grid sizes initially (can be changed later). 122 | ! set a default resize increment to increase the size of link 123 | ! arrays if the number of links exceeds the initial size 124 | ! 125 | !----------------------------------------------------------------------- 126 | 127 | num_links_map1 = 0 128 | max_links_map1 = 4*grid2_size 129 | if (num_maps > 1) then 130 | num_links_map2 = 0 131 | max_links_map1 = max(4*grid1_size,4*grid2_size) 132 | max_links_map2 = max_links_map1 133 | endif 134 | 135 | resize_increment = 0.1*max(grid1_size,grid2_size) 136 | 137 | !----------------------------------------------------------------------- 138 | ! 139 | ! allocate address and weight arrays for mapping 1 140 | ! 141 | !----------------------------------------------------------------------- 142 | 143 | allocate (grid1_add_map1(max_links_map1), 144 | & grid2_add_map1(max_links_map1), 145 | & wts_map1(num_wts, max_links_map1)) 146 | 147 | !----------------------------------------------------------------------- 148 | ! 149 | ! allocate address and weight arrays for mapping 2 if necessary 150 | ! 151 | !----------------------------------------------------------------------- 152 | 153 | if (num_maps > 1) then 154 | allocate (grid1_add_map2(max_links_map2), 155 | & grid2_add_map2(max_links_map2), 156 | & wts_map2(num_wts, max_links_map2)) 157 | endif 158 | 159 | !----------------------------------------------------------------------- 160 | 161 | end subroutine init_remap_vars 162 | 163 | !*********************************************************************** 164 | 165 | subroutine resize_remap_vars(nmap, increment) 166 | 167 | !----------------------------------------------------------------------- 168 | ! 169 | ! this routine resizes remapping arrays by increasing(decreasing) 170 | ! the max_links by increment 171 | ! 172 | !----------------------------------------------------------------------- 173 | 174 | !----------------------------------------------------------------------- 175 | ! 176 | ! input variables 177 | ! 178 | !----------------------------------------------------------------------- 179 | 180 | integer (SCRIP_i4), intent(in) :: 181 | & nmap, ! identifies which mapping array to resize 182 | & increment ! the number of links to add(subtract) to arrays 183 | 184 | !----------------------------------------------------------------------- 185 | ! 186 | ! local variables 187 | ! 188 | !----------------------------------------------------------------------- 189 | 190 | integer (SCRIP_i4) :: 191 | & ierr, ! error flag 192 | & mxlinks ! size of link arrays 193 | 194 | integer (SCRIP_i4), dimension(:), allocatable :: 195 | & add1_tmp, ! temp array for resizing address arrays 196 | & add2_tmp ! temp array for resizing address arrays 197 | 198 | real (SCRIP_r8), dimension(:,:), allocatable :: 199 | & wts_tmp ! temp array for resizing weight arrays 200 | 201 | !----------------------------------------------------------------------- 202 | ! 203 | ! resize map 1 arrays if required. 204 | ! 205 | !----------------------------------------------------------------------- 206 | 207 | select case (nmap) 208 | case(1) 209 | 210 | !*** 211 | !*** allocate temporaries to hold original values 212 | !*** 213 | 214 | mxlinks = size(grid1_add_map1) 215 | allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 216 | & wts_tmp(num_wts,mxlinks)) 217 | 218 | add1_tmp = grid1_add_map1 219 | add2_tmp = grid2_add_map1 220 | wts_tmp = wts_map1 221 | 222 | !*** 223 | !*** deallocate originals and increment max_links then 224 | !*** reallocate arrays at new size 225 | !*** 226 | 227 | deallocate (grid1_add_map1, grid2_add_map1, wts_map1) 228 | max_links_map1 = mxlinks + increment 229 | allocate (grid1_add_map1(max_links_map1), 230 | & grid2_add_map1(max_links_map1), 231 | & wts_map1(num_wts,max_links_map1)) 232 | 233 | !*** 234 | !*** restore original values from temp arrays and 235 | !*** deallocate temps 236 | !*** 237 | 238 | mxlinks = min(mxlinks, max_links_map1) 239 | grid1_add_map1(1:mxlinks) = add1_tmp (1:mxlinks) 240 | grid2_add_map1(1:mxlinks) = add2_tmp (1:mxlinks) 241 | wts_map1 (:,1:mxlinks) = wts_tmp(:,1:mxlinks) 242 | deallocate(add1_tmp, add2_tmp, wts_tmp) 243 | 244 | !----------------------------------------------------------------------- 245 | ! 246 | ! resize map 2 arrays if required. 247 | ! 248 | !----------------------------------------------------------------------- 249 | 250 | case(2) 251 | 252 | !*** 253 | !*** allocate temporaries to hold original values 254 | !*** 255 | 256 | mxlinks = size(grid1_add_map2) 257 | allocate (add1_tmp(mxlinks), add2_tmp(mxlinks), 258 | & wts_tmp(num_wts,mxlinks),stat=ierr) 259 | if (ierr .ne. 0) then 260 | print *,'error allocating temps in resize: ',ierr 261 | stop 262 | endif 263 | 264 | add1_tmp = grid1_add_map2 265 | add2_tmp = grid2_add_map2 266 | wts_tmp = wts_map2 267 | 268 | !*** 269 | !*** deallocate originals and increment max_links then 270 | !*** reallocate arrays at new size 271 | !*** 272 | 273 | deallocate (grid1_add_map2, grid2_add_map2, wts_map2) 274 | max_links_map2 = mxlinks + increment 275 | allocate (grid1_add_map2(max_links_map2), 276 | & grid2_add_map2(max_links_map2), 277 | & wts_map2(num_wts,max_links_map2),stat=ierr) 278 | if (ierr .ne. 0) then 279 | print *,'error allocating new arrays in resize: ',ierr 280 | stop 281 | endif 282 | 283 | 284 | !*** 285 | !*** restore original values from temp arrays and 286 | !*** deallocate temps 287 | !*** 288 | 289 | mxlinks = min(mxlinks, max_links_map2) 290 | grid1_add_map2(1:mxlinks) = add1_tmp (1:mxlinks) 291 | grid2_add_map2(1:mxlinks) = add2_tmp (1:mxlinks) 292 | wts_map2 (:,1:mxlinks) = wts_tmp(:,1:mxlinks) 293 | deallocate(add1_tmp, add2_tmp, wts_tmp) 294 | 295 | end select 296 | 297 | !----------------------------------------------------------------------- 298 | 299 | end subroutine resize_remap_vars 300 | 301 | !*********************************************************************** 302 | 303 | end module remap_vars 304 | 305 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 306 | -------------------------------------------------------------------------------- /SCRIP/source/serial/SCRIP_CommMod.F90: -------------------------------------------------------------------------------- 1 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 2 | !BOP 3 | 4 | module SCRIP_CommMod 5 | 6 | ! !MODULE: SCRIP_CommMod 7 | ! !DESCRIPTION: 8 | ! This module contains necessary routines and variables to support 9 | ! parallel communication modules in SCRIP. A typical SCRIP user will 10 | ! not call any of these routines - they are only for internal SCRIP 11 | ! use. 12 | ! 13 | ! The module contains communicators, tags, task ids and other 14 | ! information and the routines to set them up. In addition, several 15 | ! utility routines for setting up the communication environment are 16 | ! included. For this serial version, most of these routines simply 17 | ! set dummy values and perform no operations. 18 | ! 19 | ! !REVISION HISTORY: 20 | ! SVN:$Id: $ 21 | ! 22 | ! !USES: 23 | 24 | use SCRIP_KindsMod 25 | 26 | implicit none 27 | private 28 | save 29 | 30 | ! !PUBLIC MEMBER FUNCTIONS: 31 | 32 | public :: SCRIP_CommInit, & 33 | SCRIP_CommInitMessageEnvironment, & 34 | SCRIP_CommExitMessageEnvironment, & 35 | SCRIP_CommAbortMessageEnvironment, & 36 | SCRIP_CommGetNumProcs, & 37 | SCRIP_CommCreateCommunicator 38 | 39 | ! !PUBLIC DATA MEMBERS: 40 | 41 | integer (SCRIP_i4), public :: & 42 | SCRIP_communicator, &! MPI communicator for ocn comms 43 | SCRIP_mpiR8, &! MPI type for r8 44 | SCRIP_mpiR4, &! MPI type for r4 45 | SCRIP_myTask, &! MPI task number for this task 46 | SCRIP_masterTask ! MPI task number for master task 47 | 48 | integer (SCRIP_i4), parameter, public :: & 49 | SCRIP_mpitagBndy2d = 1, &! MPI tags for various 50 | SCRIP_mpitagGS = 1000 ! communication patterns 51 | 52 | !EOP 53 | !BOC 54 | !EOC 55 | !*********************************************************************** 56 | 57 | contains 58 | 59 | !*********************************************************************** 60 | !BOP 61 | ! !IROUTINE: SCRIP_CommInit 62 | ! !INTERFACE: 63 | 64 | subroutine SCRIP_CommInit 65 | 66 | ! !DESCRIPTION: 67 | ! This routine sets up communication environment and defines the SCRIP 68 | ! communicator. 69 | ! 70 | ! !REVISION HISTORY: 71 | ! same as module 72 | ! 73 | 74 | !EOP 75 | !BOC 76 | !----------------------------------------------------------------------- 77 | ! 78 | ! local variables 79 | ! 80 | !----------------------------------------------------------------------- 81 | 82 | !----------------------------------------------------------------------- 83 | ! 84 | ! Create communicator for internal SCRIP communications 85 | ! serial execution - set a dummy value 86 | ! 87 | !----------------------------------------------------------------------- 88 | 89 | SCRIP_communicator = 0 90 | 91 | !----------------------------------------------------------------------- 92 | ! 93 | ! initialize other variables with dummy value for the serial case 94 | ! 95 | !----------------------------------------------------------------------- 96 | 97 | SCRIP_masterTask = 0 98 | SCRIP_myTask = 0 99 | SCRIP_mpiR8 = 0 100 | SCRIP_mpiR4 = 0 101 | 102 | !----------------------------------------------------------------------- 103 | !EOC 104 | 105 | end subroutine SCRIP_CommInit 106 | 107 | !*********************************************************************** 108 | !BOP 109 | ! !IROUTINE: SCRIP_CommGetNumProcs 110 | ! !INTERFACE: 111 | 112 | function SCRIP_CommGetNumProcs(communicator) 113 | 114 | ! !DESCRIPTION: 115 | ! This function returns the number of processor assigned to 116 | ! a given communicator. 117 | ! 118 | ! !REVISION HISTORY: 119 | ! same as module 120 | 121 | ! !INPUT PARAMETERS: 122 | 123 | integer (SCRIP_i4), intent(in) :: & 124 | communicator ! communicator to query for num processors 125 | 126 | ! !OUTPUT PARAMETERS: 127 | 128 | integer (SCRIP_i4) :: & 129 | SCRIP_CommGetNumProcs ! number of processors in communicator 130 | 131 | !EOP 132 | !BOC 133 | !----------------------------------------------------------------------- 134 | ! 135 | ! always return one for serial case 136 | ! 137 | !----------------------------------------------------------------------- 138 | 139 | SCRIP_CommGetNumProcs = 1 140 | 141 | !----------------------------------------------------------------------- 142 | !EOC 143 | 144 | end function SCRIP_CommGetNumProcs 145 | 146 | !*********************************************************************** 147 | !BOP 148 | ! !IROUTINE: SCRIP_CommInitMessageEnvironment 149 | ! !INTERFACE: 150 | 151 | subroutine SCRIP_CommInitMessageEnvironment 152 | 153 | ! !DESCRIPTION: 154 | ! This routine initializes the message environment. 155 | ! 156 | ! !REVISION HISTORY: 157 | ! same as module 158 | 159 | !EOP 160 | !BOC 161 | !----------------------------------------------------------------------- 162 | ! 163 | ! this routine does nothing in serial case 164 | ! 165 | !----------------------------------------------------------------------- 166 | 167 | 168 | !----------------------------------------------------------------------- 169 | !EOC 170 | 171 | end subroutine SCRIP_CommInitMessageEnvironment 172 | 173 | !*********************************************************************** 174 | !BOP 175 | ! !IROUTINE: SCRIP_CommExitMessageEnvironment 176 | ! !INTERFACE: 177 | 178 | subroutine SCRIP_CommExitMessageEnvironment 179 | 180 | ! !DESCRIPTION: 181 | ! This routine exits the message environment properly when model 182 | ! stops. 183 | ! 184 | ! !REVISION HISTORY: 185 | ! same as module 186 | 187 | !EOP 188 | !BOC 189 | !----------------------------------------------------------------------- 190 | ! 191 | ! serial case does nothing 192 | ! 193 | !----------------------------------------------------------------------- 194 | 195 | !----------------------------------------------------------------------- 196 | !EOC 197 | 198 | end subroutine SCRIP_CommExitMessageEnvironment 199 | 200 | !*********************************************************************** 201 | !BOP 202 | ! !IROUTINE: SCRIP_CommAbortMessageEnvironment 203 | ! !INTERFACE: 204 | 205 | subroutine SCRIP_CommAbortMessageEnvironment 206 | 207 | ! !DESCRIPTION: 208 | ! This routine aborts the message environment when model stops. 209 | ! It will attempt to abort the entire MPI COMM WORLD. 210 | ! 211 | ! !REVISION HISTORY: 212 | ! same as module 213 | 214 | !EOP 215 | !BOC 216 | !----------------------------------------------------------------------- 217 | ! 218 | ! local variables 219 | ! 220 | !----------------------------------------------------------------------- 221 | !----------------------------------------------------------------------- 222 | ! 223 | ! serial case does nothing 224 | ! 225 | !----------------------------------------------------------------------- 226 | 227 | !----------------------------------------------------------------------- 228 | !EOC 229 | 230 | end subroutine SCRIP_CommAbortMessageEnvironment 231 | 232 | !*********************************************************************** 233 | !BOP 234 | ! !IROUTINE: SCRIP_CommCreateCommunicator 235 | ! !INTERFACE: 236 | 237 | subroutine SCRIP_CommCreateCommunicator(newCommunicator, numProcs) 238 | 239 | ! !DESCRIPTION: 240 | ! This routine enables creation of a separate communicator for a 241 | ! subset of processors under default communicator. 242 | ! 243 | ! !REVISION HISTORY: 244 | ! same as module 245 | 246 | ! !INPUT PARAMETERS: 247 | 248 | integer (SCRIP_i4), intent(in) :: & 249 | numProcs ! num of procs in new distribution 250 | 251 | ! !OUTPUT PARAMETERS: 252 | 253 | integer (SCRIP_i4), intent(out) :: & 254 | newCommunicator ! new communicator for this distribution 255 | 256 | !EOP 257 | !BOC 258 | !----------------------------------------------------------------------- 259 | ! 260 | ! set dummy value for serial case 261 | ! 262 | !----------------------------------------------------------------------- 263 | 264 | newCommunicator = 0 265 | 266 | !----------------------------------------------------------------------- 267 | !EOC 268 | 269 | end subroutine SCRIP_CommCreateCommunicator 270 | 271 | !*********************************************************************** 272 | 273 | end module SCRIP_CommMod 274 | 275 | !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| 276 | -------------------------------------------------------------------------------- /SCRIP/source/timers.f: -------------------------------------------------------------------------------- 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 | ! 3 | ! This module uses F90 cpu time routines to allowing setting of 4 | ! multiple CPU timers. 5 | ! 6 | !----------------------------------------------------------------------- 7 | ! 8 | ! CVS:$Id: timers.f,v 1.2 2000/04/19 21:56:26 pwjones Exp $ 9 | ! 10 | ! Copyright (c) 1997, 1998 the Regents of the University of 11 | ! California. 12 | ! 13 | ! This software and ancillary information (herein called software) 14 | ! called SCRIP is made available under the terms described here. 15 | ! The software has been approved for release with associated 16 | ! LA-CC Number 98-45. 17 | ! 18 | ! Unless otherwise indicated, this software has been authored 19 | ! by an employee or employees of the University of California, 20 | ! operator of the Los Alamos National Laboratory under Contract 21 | ! No. W-7405-ENG-36 with the U.S. Department of Energy. The U.S. 22 | ! Government has rights to use, reproduce, and distribute this 23 | ! software. The public may copy and use this software without 24 | ! charge, provided that this Notice and any statement of authorship 25 | ! are reproduced on all copies. Neither the Government nor the 26 | ! University makes any warranty, express or implied, or assumes 27 | ! any liability or responsibility for the use of this software. 28 | ! 29 | ! If software is modified to produce derivative works, such modified 30 | ! software should be clearly marked, so as not to confuse it with 31 | ! the version available from Los Alamos National Laboratory. 32 | ! 33 | !*********************************************************************** 34 | 35 | module timers 36 | 37 | !----------------------------------------------------------------------- 38 | 39 | use SCRIP_KindsMod ! defines common data types 40 | 41 | implicit none 42 | 43 | integer (SCRIP_i4), parameter :: 44 | & max_timers = 99 ! max number of timers allowed 45 | 46 | integer (SCRIP_i4), save :: 47 | & cycles_max ! max value of clock allowed by system 48 | 49 | integer (SCRIP_i4), dimension(max_timers), save :: 50 | & cycles1, ! cycle number at start for each timer 51 | & cycles2 ! cycle number at stop for each timer 52 | 53 | real (SCRIP_r4), save :: 54 | & clock_rate ! clock_rate in seconds for each cycle 55 | 56 | real (SCRIP_r4), dimension(max_timers), save :: 57 | & cputime ! accumulated cpu time in each timer 58 | 59 | character (len=8), dimension(max_timers), save :: 60 | & status ! timer status string 61 | 62 | !*********************************************************************** 63 | 64 | contains 65 | 66 | !*********************************************************************** 67 | 68 | subroutine timer_check(timer) 69 | 70 | !----------------------------------------------------------------------- 71 | ! 72 | ! This routine checks a given timer. This is primarily used to 73 | ! periodically accumulate time in the timer to prevent timer cycles 74 | ! from wrapping around max_cycles. 75 | ! 76 | !----------------------------------------------------------------------- 77 | 78 | !----------------------------------------------------------------------- 79 | ! 80 | ! Input Variables: 81 | ! 82 | !----------------------------------------------------------------------- 83 | 84 | integer (SCRIP_i4), intent(in) :: 85 | & timer ! timer number 86 | 87 | !----------------------------------------------------------------------- 88 | 89 | if (status(timer) .eq. 'running') then 90 | call timer_stop (timer) 91 | call timer_start(timer) 92 | endif 93 | 94 | !----------------------------------------------------------------------- 95 | 96 | end subroutine timer_check 97 | 98 | !*********************************************************************** 99 | 100 | subroutine timer_clear(timer) 101 | 102 | !----------------------------------------------------------------------- 103 | ! 104 | ! This routine resets a given timer. 105 | ! 106 | !----------------------------------------------------------------------- 107 | 108 | !----------------------------------------------------------------------- 109 | ! 110 | ! Input Variables: 111 | ! 112 | !----------------------------------------------------------------------- 113 | 114 | integer (SCRIP_i4), intent(in) :: 115 | & timer ! timer number 116 | 117 | !----------------------------------------------------------------------- 118 | 119 | cputime(timer) = 0.0_SCRIP_r4 ! clear the timer 120 | 121 | !----------------------------------------------------------------------- 122 | 123 | end subroutine timer_clear 124 | 125 | !*********************************************************************** 126 | 127 | function timer_get(timer) 128 | 129 | !----------------------------------------------------------------------- 130 | ! 131 | ! This routine returns the result of a given timer. This can be 132 | ! called instead of timer_print so that the calling routine can 133 | ! print it in desired format. 134 | ! 135 | !----------------------------------------------------------------------- 136 | 137 | !----------------------------------------------------------------------- 138 | ! 139 | ! Input Variables: 140 | ! 141 | !----------------------------------------------------------------------- 142 | 143 | integer (SCRIP_i4), intent(in) :: 144 | & timer ! timer number 145 | 146 | !----------------------------------------------------------------------- 147 | ! 148 | ! Output Variables: 149 | ! 150 | !----------------------------------------------------------------------- 151 | 152 | real (SCRIP_r4) :: 153 | & timer_get ! accumulated cputime in given timer 154 | 155 | !----------------------------------------------------------------------- 156 | 157 | if (status(timer) .eq. 'stopped') then 158 | timer_get = cputime(timer) 159 | else 160 | call timer_stop(timer) 161 | timer_get = cputime(timer) 162 | call timer_start(timer) 163 | endif 164 | 165 | !----------------------------------------------------------------------- 166 | 167 | end function timer_get 168 | 169 | !*********************************************************************** 170 | 171 | subroutine timer_print(timer) 172 | 173 | !----------------------------------------------------------------------- 174 | ! 175 | ! This routine prints the accumulated cpu time in given timer. 176 | ! 177 | !----------------------------------------------------------------------- 178 | 179 | !----------------------------------------------------------------------- 180 | ! 181 | ! Input Variables: 182 | ! 183 | !----------------------------------------------------------------------- 184 | 185 | integer (SCRIP_i4), intent(in) :: 186 | & timer ! timer number 187 | 188 | !----------------------------------------------------------------------- 189 | 190 | !--- 191 | !--- print the cputime accumulated for timer 192 | !--- make sure timer is stopped 193 | !--- 194 | 195 | if (status(timer) .eq. 'stopped') then 196 | write(*,"(' CPU time for timer',i3,':',1p,e16.8)") 197 | & timer,cputime(timer) 198 | else 199 | call timer_stop(timer) 200 | write(*,"(' CPU time for timer',i3,':',1p,e16.8)") 201 | & timer,cputime(timer) 202 | call timer_start(timer) 203 | endif 204 | 205 | !----------------------------------------------------------------------- 206 | 207 | end subroutine timer_print 208 | 209 | !*********************************************************************** 210 | 211 | subroutine timer_start(timer) 212 | 213 | !----------------------------------------------------------------------- 214 | ! 215 | ! This routine starts a given timer. 216 | ! 217 | !----------------------------------------------------------------------- 218 | 219 | !----------------------------------------------------------------------- 220 | ! 221 | ! Input Variables: 222 | ! 223 | !----------------------------------------------------------------------- 224 | 225 | integer (SCRIP_i4), intent(in) :: 226 | & timer ! timer number 227 | 228 | !----------------------------------------------------------------------- 229 | 230 | !--- 231 | !--- Start the timer and change timer status. 232 | !--- 233 | 234 | if (status(timer) .eq. 'stopped') then 235 | call system_clock(count=cycles1(timer)) 236 | status(timer) = 'running' 237 | endif 238 | 239 | !----------------------------------------------------------------------- 240 | 241 | end subroutine timer_start 242 | 243 | !*********************************************************************** 244 | 245 | subroutine timer_stop(timer) 246 | 247 | !----------------------------------------------------------------------- 248 | ! 249 | ! This routine stops a given timer. 250 | ! 251 | !----------------------------------------------------------------------- 252 | 253 | !----------------------------------------------------------------------- 254 | ! 255 | ! Input Variables: 256 | ! 257 | !----------------------------------------------------------------------- 258 | 259 | integer (SCRIP_i4), intent(in) :: 260 | & timer ! timer number 261 | 262 | !----------------------------------------------------------------------- 263 | 264 | if (status(timer) .eq. 'running') then 265 | 266 | !--- 267 | !--- Stop the desired timer. 268 | !--- 269 | 270 | call system_clock(count=cycles2(timer)) 271 | 272 | !--- 273 | !--- check and correct for cycle wrapping 274 | !--- 275 | 276 | if (cycles2(timer) .ge. cycles1(timer)) then 277 | cputime(timer) = cputime(timer) + clock_rate* 278 | & (cycles2(timer) - cycles1(timer)) 279 | else 280 | cputime(timer) = cputime(timer) + clock_rate* 281 | & (cycles2(timer) - cycles1(timer) + cycles_max) 282 | endif 283 | 284 | !--- 285 | !--- Change timer status. 286 | !--- 287 | 288 | status(timer)='stopped' 289 | 290 | endif 291 | 292 | !----------------------------------------------------------------------- 293 | 294 | end subroutine timer_stop 295 | 296 | !*********************************************************************** 297 | 298 | subroutine timers_init 299 | 300 | !----------------------------------------------------------------------- 301 | ! 302 | ! This routine initializes some machine parameters necessary for 303 | ! computing cpu time from F90 intrinsics. 304 | ! 305 | !----------------------------------------------------------------------- 306 | 307 | integer (SCRIP_i4) :: cycles ! count rate return by sys_clock 308 | 309 | !----------------------------------------------------------------------- 310 | 311 | !--- 312 | !--- Initialize timer arrays and clock_rate. 313 | !--- 314 | 315 | clock_rate = 0.0_SCRIP_r4 316 | cycles1 = 0 317 | cycles2 = 0 318 | cputime = 0.0_SCRIP_r4 319 | status = 'stopped' 320 | 321 | !--- 322 | !--- Call F90 intrinsic system_clock to determine clock rate 323 | !--- and maximum cycles. If no clock available, print message. 324 | !--- 325 | 326 | call system_clock(count_rate=cycles, count_max=cycles_max) 327 | 328 | if (cycles /= 0) then 329 | clock_rate = 1.0_SCRIP_r4/real(cycles) 330 | else 331 | clock_rate = 0.0_SCRIP_r4 332 | print *, '--- No system clock available ---' 333 | endif 334 | 335 | !----------------------------------------------------------------------- 336 | 337 | end subroutine timers_init 338 | 339 | !*********************************************************************** 340 | 341 | end module timers 342 | 343 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 344 | --------------------------------------------------------------------------------