C=============================================================================C C International Comprehensive Ocean-Atmosphere Data Set (ICOADS) 9 Jan 2013 C C Filename:level: ptii.f:01I Fortran 77 program C C Function: LMR6 platform type and ID indicator Author: S.Lubker C C=============================================================================C C Software documentation for the (invariant) user-interface routine {ptii}. C C Functionality: Compute platform type (PT) and ID indicator (II), based on C deck (DCK) and the eight characters of the ID field, as provided in ID1-ID8. C This routine handles only decks defined for 1980 forward; i.e., all of the C original Release 1a decks, plus decks 792-796 and 992-996. Buoy decks C 793-794 and 993-994, in which the deck number refers to the code data were C received in, are handled differently than 893-894, in which the deck number C refers to the buoy type. Code is included to handle decks 796 and 996, but C no data of these types can be identified currently and the decks are empty. C In the event that deck isn't recognized (or is missing), PT is left unchanged C and II may be left unchanged. C C=============================================================================C C WARNING: Code beyond this point should not require any modification. C C=============================================================================C C$PTII------------------------------------------------------------------3456789 SUBROUTINE PTII(DCK,PT,II,ID1,ID2,ID3,ID4,ID5,ID6,ID7,ID8,MISS) IMPLICIT INTEGER(A-Z) CHARACTER*1 B2,B3 LOGICAL BUOY,SHIP,RIGG,PLAT,NNXX,DRIB,MASKSTID LOGICAL SHIP ID,BUOY ID,MOOR ID,DRIF ID,CMAN ID,OSV ID,EB NUM +,ANY ID LOGICAL BOUND,EQUAL,ALPHA,NUMER,SPACE BOUND(B1,B2,B3)=B1.GE.ICHAR(B2) .AND. B1.LE.ICHAR(B3) EQUAL(B1,B2)=B1.EQ.ICHAR(B2) ALPHA(B)=B.GE.ICHAR('A') .AND. B.LE.ICHAR('Z') NUMER(B)=B.GE.ICHAR('0') .AND. B.LE.ICHAR('9') SPACE(B)=B.EQ.ICHAR(' ') C BUOY= + EQUAL(ID1,'B') +.AND. EQUAL(ID2,'U') +.AND. EQUAL(ID3,'O') +.AND. EQUAL(ID4,'Y') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C SHIP= + EQUAL(ID1,'S') +.AND. EQUAL(ID2,'H') +.AND. EQUAL(ID3,'I') +.AND. EQUAL(ID4,'P') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C RIGG= + EQUAL(ID1,'R') +.AND. EQUAL(ID2,'I') +.AND. EQUAL(ID3,'G') +.AND. EQUAL(ID4,'G') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C PLAT= + EQUAL(ID1,'P') +.AND. EQUAL(ID2,'L') +.AND. EQUAL(ID3,'A') +.AND. EQUAL(ID4,'T') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C NNXX= + EQUAL(ID1,'N') +.AND. EQUAL(ID2,'N') +.AND. EQUAL(ID3,'X') +.AND. EQUAL(ID4,'X') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C DRIB= + DCK.EQ.888 +.AND. EQUAL(ID1,'D') +.AND. EQUAL(ID2,'R') +.AND. EQUAL(ID3,'I') +.AND. EQUAL(ID4,'B') +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C MASKSTID= + EQUAL(ID1,'M') +.AND. EQUAL(ID2,'A') +.AND. EQUAL(ID3,'S') +.AND. EQUAL(ID4,'K') +.AND. EQUAL(ID5,'S') +.AND. EQUAL(ID6,'T') +.AND. EQUAL(ID7,'I') +.AND. EQUAL(ID8,'D') C SHIP ID= + (ALPHA(ID1) .OR. NUMER(ID1)) +.AND.(ALPHA(ID2) .OR. NUMER(ID2)) +.AND.(ALPHA(ID3) .OR. NUMER(ID3)) +.AND.(ALPHA(ID4) .OR. NUMER(ID4)) +.AND.(ALPHA(ID5) .OR. NUMER(ID5) .OR. SPACE(ID5)) +.AND.(ALPHA(ID6) .OR. NUMER(ID6) .OR. SPACE(ID6)) +.AND.(ALPHA(ID7) .OR. NUMER(ID7) .OR. SPACE(ID7)) +.AND. SPACE(ID8) +.AND.(ALPHA(ID1) +.OR. ALPHA(ID2) +.OR. ALPHA(ID3) +.OR. ALPHA(ID4) +.OR. ALPHA(ID5) +.OR. ALPHA(ID6) +.OR. ALPHA(ID7)) C BUOY ID= + (EQUAL(ID1,'1') .AND. BOUND(ID2,'1','7') +.OR. EQUAL(ID1,'2') .AND. BOUND(ID2,'1','6') +.OR. EQUAL(ID1,'3') .AND. BOUND(ID2,'1','4') +.OR. EQUAL(ID1,'4') .AND. BOUND(ID2,'1','8') +.OR. EQUAL(ID1,'5') .AND. BOUND(ID2,'1','6') +.OR. EQUAL(ID1,'6') .AND. BOUND(ID2,'1','6') +.OR. EQUAL(ID1,'7') .AND. BOUND(ID2,'1','4')) +.AND. NUMER(ID3) +.AND. NUMER(ID4) +.AND. NUMER(ID5) +.AND.(SPACE(ID6) +.OR. BOUND(ID6,'A','I') .AND. (DCK.EQ.893 .OR. DCK.EQ.894)) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C MOOR ID= + BUOY ID +.AND. BOUND(ID3,'0','4') C DRIF ID= + BUOY ID +.AND. BOUND(ID3,'5','9') C CMAN ID= + ALPHA(ID1) +.AND. ALPHA(ID2) +.AND. ALPHA(ID3) +.AND. ALPHA(ID4) +.AND. NUMER(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) +.OR. + EQUAL(ID1,'9') +.AND. EQUAL(ID2,'1') +.AND. NUMER(ID3) +.AND. NUMER(ID4) +.AND. NUMER(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C OSV ID= + EQUAL(ID1,'C') +.AND. EQUAL(ID2,'7') +.AND. ALPHA(ID3) +.AND. SPACE(ID4) +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C EB NUM= + (EQUAL(ID1,'D') .OR. EQUAL(ID1,'E')) +.AND. EQUAL(ID2,'B') +.AND. NUMER(ID3) +.AND. NUMER(ID4) +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8) C ANY ID= +.NOT.(SPACE(ID1) +.AND. SPACE(ID2) +.AND. SPACE(ID3) +.AND. SPACE(ID4) +.AND. SPACE(ID5) +.AND. SPACE(ID6) +.AND. SPACE(ID7) +.AND. SPACE(ID8)) C IF (ANY ID) THEN IF (II.EQ.MISS) THEN II=0 ENDIF ELSE II=MISS ENDIF C IF ( + DCK.EQ.555 .AND. OSV ID +.OR. DCK.EQ.732 .AND. OSV ID +.OR. DCK.EQ.874 .AND. OSV ID +.OR. DCK.EQ.888 .AND. OSV ID +.OR. DCK.EQ.796 .AND. OSV ID +.OR. DCK.EQ.896 .AND. OSV ID +.OR. DCK.EQ.996 .AND. OSV ID +.OR. DCK.EQ.926 .AND. OSV ID +.OR. DCK.EQ.927 .AND. OSV ID +) THEN PT=2 IF (OSV ID) THEN II=1 ENDIF C ELSE IF ( + DCK.EQ.714 .AND. MOOR ID +.OR. DCK.EQ.883 .AND. MOOR ID +.OR. DCK.EQ.700 .AND.(MOOR ID .OR. BUOY) +.OR. DCK.EQ.793 .AND.(MOOR ID .OR. BUOY) +.OR. DCK.EQ.893 +.OR. DCK.EQ.993 .AND.(MOOR ID .OR. BUOY) +.OR. DCK.EQ.794 .AND.(MOOR ID .OR. BUOY) +.OR. DCK.EQ.894 .AND.(MOOR ID .OR. BUOY) +.OR. DCK.EQ.994 .AND.(MOOR ID .OR. BUOY) +) THEN IF (PT.EQ.MISS .OR. DCK.NE.793 .AND. DCK.NE.993 + .AND. DCK.NE.794 .AND. DCK.NE.994) THEN PT=6 ENDIF IF (MOOR ID) THEN II=3 ENDIF C ELSE IF ( + DCK.EQ.555 .AND.(EB NUM .OR. BUOY) +.OR. DCK.EQ.883 .AND.(EB NUM .OR. BUOY) +.OR. DCK.EQ.888 .AND.(EB NUM .OR. BUOY) +) THEN PT=6 IF (EB NUM) THEN II=4 ENDIF C ELSE IF ( + DCK.EQ.714 .AND. DRIF ID +.OR. DCK.EQ.883 .AND. DRIF ID +.OR. DCK.EQ.888 .AND.(DRIF ID .OR. DRIB) +.OR. DCK.EQ.700 .AND. DRIF ID +.OR. DCK.EQ.793 .AND. DRIF ID +.OR. DCK.EQ.993 .AND. DRIF ID +.OR. DCK.EQ.794 .AND. DRIF ID +.OR. DCK.EQ.894 +.OR. DCK.EQ.994 .AND. DRIF ID +) THEN IF (PT.EQ.MISS .OR. DCK.NE.793 .AND. DCK.NE.993 + .AND. DCK.NE.794 .AND. DCK.NE.994) THEN PT=7 ENDIF IF (DRIF ID) THEN II=3 ENDIF C ELSE IF ( + DCK.EQ.733 +) THEN PT=9 IF (II.NE.MISS) THEN II=6 ENDIF C ELSE IF ( + DCK.EQ.883 .AND. CMAN ID +.OR. DCK.EQ.795 +.OR. DCK.EQ.895 +.OR. DCK.EQ.995 +) THEN IF (PT.EQ.MISS .OR. DCK.NE.795 .AND. DCK.NE.995) THEN PT=13 ENDIF IF (CMAN ID) THEN II=5 ENDIF C ELSE IF ( + DCK.EQ.555 .AND.(RIGG .OR. PLAT) +.OR. DCK.EQ.888 .AND.(RIGG .OR. PLAT) +.OR. DCK.EQ.796 .AND.(RIGG .OR. PLAT) +.OR. DCK.EQ.896 .AND.(RIGG .OR. PLAT) +.OR. DCK.EQ.996 .AND.(RIGG .OR. PLAT) +) THEN PT=15 C ELSE IF ( + DCK.EQ.797 +.OR. DCK.EQ.997 +) THEN IF (CMAN ID) THEN II=5 ENDIF C ELSE IF ( + DCK.EQ.667 +) THEN PT=5 IF (II.NE.MISS) THEN II=8 ENDIF C ELSE IF ( + DCK.EQ.555 +.OR. DCK.EQ.700 +.OR. DCK.EQ.732 +.OR. DCK.EQ.874 +.OR. DCK.EQ.888 +.OR. DCK.EQ.889 +.OR. DCK.EQ.792 +.OR. DCK.EQ.892 +.OR. DCK.EQ.992 +.OR. DCK.EQ.926 +.OR. DCK.EQ.927 +) THEN IF (PT.EQ.MISS .OR. DCK.NE.792 .AND. DCK.NE.992) THEN PT=5 ENDIF IF (SHIP ID) THEN II=1 ENDIF C ELSE IF ( + DCK.GE.201 .AND. DCK.LE.255 +) THEN IF (II.EQ.0 .AND. SHIP ID) THEN II=1 ENDIF RETURN ENDIF C IF (BUOY .OR. SHIP .OR. RIGG .OR. PLAT .OR. NNXX .OR. DRIB +.OR. MASKSTID) II=2 END