gradsScriptCreation.f
********************************************************************************
* This file collects functions for the creation of visualisation scripts
* in grads script.
* TODO: to be extended
5: *******************************************************************************
SUBROUTINE openSimpleGS (p_fileId, p_fileName,p_bgName,p_varName)
************************************************************************
* Opens a normal grads script file with grads logo and axes turned off and the
10: * passed in self-describing netcdf file as background.
*
* Input:
* - p_fileId (Integer): the unit number of the file
* - p_fileName (String): the name of the new file (the grads script file extension
15: * ".gs" is automatically appended to the name!)
* - p_bgName (String): a self-describing NetCDF file for the background (full file name)
* - p_varName (String): the name of the variable in the NetCDF file to be displayed
************************************************************************
20: * Functions from the function library
INTEGER strlen
* Parameters
INTEGER p_fileId
25: CHARACTER*(*) p_fileName, p_bgName, p_varName
* Vars
CHARACTER fileName*100, bgName*100, varName*20
fileName = p_fileName
30: bgName = p_bgName
varName=p_varName
* Open grads script file to be written
OPEN(p_fileId,
35: c file=fileName(1:strlen(fileName)) // ".gs" )
WRITE (p_fileId, *) "say 'Autogenerated GradsScript File'"
WRITE (p_fileId, *) "say 'Opening the background'"
WRITE (p_fileId, *) "'sdfopen " // bgName(1:strlen(bgName)) // "'"
40: * Shaded background style
WRITE (p_fileId, *) "'set gxout shaded'"
WRITE (p_fileId, *) "'c'"
WRITE (p_fileId, *) "'set xlab off'"
WRITE (p_fileId, *) "'set ylab off'"
45: WRITE (p_fileId, *) "'set grads off'"
if (strlen(varName) > 0)
c WRITE (p_fileId, *) "'d ", varName(1:strlen(varName)) , "'"
END
50:
SUBROUTINE drawGSPt (p_fileId, p_lat, p_lon, p_size,
c p_style, p_label)
************************************************************************
55: * Writes the code into the grads script file for drawing a marker point
* on the NetCDF background.
*
* Input:
* - p_fileId (Integer): the unit number of the grads script file
60: * - p_lat (Real): the latitude of the point to be drawn
* - p_lon (Real): the longitude of the point to be drawn
* - p_size (Real): the size of the point (for coordinate locations 0.1 is
* normally small, 0.3 medium, 0.5 big)
* - p_style (Integer): which style the marker should have, available:
65: * 1 = cross,
* 2 = open circle
* 3 = closed circle
* 4 = open square
* 5 = closed square
70: * 6 = X
* 7 = diamond
* 8 = triangle
* 9 = none
* 10 = open circle with vertical line
75: * 11 = open oval
* - p_label (String): if anything but "" is passed in, this label is written
* next to the marker point
************************************************************************
80: INTEGER p_fileId, p_style, strlen
REAL p_lat, p_lon, p_size !params
CHARACTER p_label*(*), label*50
label = p_label
85: WRITE (p_fileId, *) ""
WRITE (p_fileId, *) "'q ll2xy", p_lon, p_lat, "'"
WRITE (p_fileId, *) "xco = subwrd(result,1)"
WRITE (p_fileId, *) "yco = subwrd(result,2)"
WRITE (p_fileId, *) "'draw mark ",p_style,
90: c " ' xco ' ' yco '", p_size, "'"
if (strlen(label) > 0)
c WRITE (p_fileId, *) "'draw string ' xco+0.2 ' ' yco-0.1 ' " //
c label(1:strlen(label)) // "'"
95: END
SUBROUTINE closeSimpleGS (p_fileId, p_fileName)
************************************************************************
100: * Finishes (i.e. writes command for GrADS meta file output) and closes
* the open grads script file.
*
* Input:
* - p_fileId (Integer): the unit number of the file
105: * - p_fileName (String): the name of the script output file (the grads metafile
* extension ".gds" is automatically appended to the name!)
************************************************************************
110: * Functions from the function library
INTEGER strlen
* Parameters
INTEGER p_fileId
115: CHARACTER p_fileName*(*)
* Vars
CHARACTER fileName*100
fileName = p_fileName
120: fileName = fileName(1:strlen(fileName)) // '.gds'
WRITE (p_fileId, *) "'enable print ",
c fileName(1:strlen(fileName)),"'"
WRITE (p_fileId, *) "'print'"
125: WRITE (p_fileId, *) "'disable print'"
WRITE (p_fileId, *) "'quit'"
CLOSE(p_fileId)
END
Info Section
Warning: externals (function calls) may not be acurate
back to top
f2html v0.3 (C) 1997,98 Beroud Jean-Marc. Fri Aug 11 17:54:58 CEST 2006