40aa780b3d
Former-commit-id:7fa9dbd5fb[formerly4bfbdad17d] [formerly9f8cb727a5] [formerly8485b90ff8[formerly9f8cb727a5[formerly bf53d06834caa780226121334ac1bcf0534c3f16]]] Former-commit-id:8485b90ff8Former-commit-id: 73930fb29d0c1e91204e76e6ebfdbe757414f319 [formerlya28d70b5c5] Former-commit-id:33a67cdd82
71 lines
3.4 KiB
Fortran
71 lines
3.4 KiB
Fortran
SUBROUTINE DB_GETGAREA ( nkeys, keynam, iloval, ihival,
|
|
+ garea, iret )
|
|
C************************************************************************
|
|
C* DB_GETGAREA *
|
|
C* *
|
|
C** *
|
|
C* Log: *
|
|
C* m.gamazaychikov/SAIC 03/09 *
|
|
C************************************************************************
|
|
CHARACTER*(*) keynam (*), garea
|
|
INTEGER iloval (*), ihival (*)
|
|
CHARACTER state(1)*2, numchar*8, dbstn*4
|
|
C------------------------------------------------------------------------
|
|
|
|
IF ( nkeys .eq. 1 ) THEN
|
|
IF ( keynam(1) .eq. "STAT" ) THEN
|
|
CALL ST_ITOC (iloval(1), nkeys, state, ier)
|
|
garea ="@"//state(1)
|
|
CALL ST_NULL ( garea, garea, lgarea, ier )
|
|
ELSE IF ( keynam(1) .eq. "COUN" ) THEN
|
|
CALL ST_ITOC (iloval(1), nkeys, state, ier)
|
|
garea ="@"//state(1)//":c"
|
|
c garea ="@"//"Canada:c"
|
|
CALL ST_NULL ( garea, garea, lgarea, ier )
|
|
ELSE IF ( keynam(1) .eq. "SELV" .or.
|
|
+ keynam(1) .eq. "SLAT" .or.
|
|
+ keynam(1) .eq. "SLON" .or.
|
|
+ keynam(1) .eq. "SPRI" ) THEN
|
|
CALL ST_INCH ( iloval(1),numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
garea =keynam(1)//':'//numchar(:nlst)//':'
|
|
CALL ST_INCH ( ihival(1),numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
CALL ST_LSTR ( garea, ngar, ier)
|
|
garea = garea(:ngar)//numchar(:nlst)
|
|
CALL ST_NULL ( garea, garea, lgarea, ier )
|
|
END IF
|
|
|
|
ELSE IF ( nkeys .eq. 2 ) THEN
|
|
IF ( keynam(1) .eq. "SLAT" .and.
|
|
+ keynam(2) .eq. "SLON") THEN
|
|
anumber = iloval(1)/100.
|
|
CALL ST_RLCH ( anumber, 2, numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
garea = numchar(:nlst)//';'
|
|
anumber = iloval(2)/100.
|
|
CALL ST_RLCH ( anumber, 2, numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
CALL ST_LSTR ( garea, ngar, ier)
|
|
garea = garea(:ngar)//numchar(:nlst)//';'
|
|
anumber = ihival(1)/100.
|
|
CALL ST_RLCH ( anumber, 2, numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
CALL ST_LSTR ( garea, ngar, ier)
|
|
garea = garea(:ngar)//numchar(:nlst)//';'
|
|
anumber = ihival(2)/100.
|
|
CALL ST_RLCH ( anumber, 2, numchar, ier)
|
|
CALL ST_LSTR ( numchar, nlst, ier)
|
|
CALL ST_LSTR ( garea, ngar, ier)
|
|
garea = garea(:ngar)//numchar(:nlst)
|
|
ELSE IF ( ( keynam(1) .eq. "STID" .and.
|
|
+ keynam(2) .eq. "STD2")
|
|
+ .or. keynam(1) .eq. "COL" ) THEN
|
|
CALL ST_ITOS (iloval, nkeys, ncar, dbstn, ier)
|
|
CALL ST_LSTR ( dbstn, ldbstr, ier )
|
|
garea="@"//dbstn(:ldbstr)
|
|
END IF
|
|
END IF
|
|
C*
|
|
RETURN
|
|
END
|