C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_set_iolabel.F,v 1.2 2010/03/16 00:22:26 jmc Exp $
C $Name:  $

#undef STAND_ALONE_IOLABEL_TESTING
C     to test the S/R above, #define the above C-PreProcessor flag
C     and compile this fortran source code alone.

#ifdef STAND_ALONE_IOLABEL_TESTING
      PROGRAM MAIN
      INTEGER NLL, I
      PARAMETER (NLL=62*62)
      CHARACTER*2 LL(NLL)

      CALL PTRACERS_SET_IOLABEL( LL, NLL, 1 )
      DO I=1, NLL
       PRINT *, LL(I)
      ENDDO
      END

#endif /* STAND_ALONE_IOLABEL_TESTING */

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CBOP
C !ROUTINE: PTRACERS_SET_IOLABEL

C !INTERFACE: ==========================================================
      SUBROUTINE PTRACERS_SET_IOLABEL(
     O                    ioLbl,
     I                    nbLbl, myThid )

C !DESCRIPTION:
C   S/R  PTRACERS_SET_IOLABEL
C   Set pTracers IO & diagnostics label (2 characters long)
C
C   Set sequenced label list 00, 02, 03, ... 99, 0a...0Z...9a...9Z,a0...ZZ
C    to more than 99 TRACERS but without requiring more than two digit labels.
C   Sequence below allows 3843 (=62**2 -1) tracers.
C   First 99 are numbered in decimal ;
C   Then, from 100 to 619, analog to base 52 counting:
C    0-9 1rst digit , a-z,A-Z (=52 id) 2nd digit ;
C   And from 620 to 3843, analog to base 62 counting:
C    a-z,A-Z 1rst digit ; 0-9,a-z,A-Z (=62 id) 2nd digit ;
C ======================================================================

C !USES:
      IMPLICIT NONE

C !INPUT PARAMETERS: ===================================================
C     nbLbl       :: number of labels to define
C     myThid      :: my Thread Id number
      INTEGER     nbLbl
      INTEGER     myThid

C !OUTPUT PARAMETERS: ==================================================
C     ioLbl       :: io-label
      CHARACTER*2 ioLbl(nbLbl)

C !LOCAL VARIABLES: ====================================================
C     c1Set1      :: 1rst digit (from left) of 1rst set of labels
C     c2Set1      ::  2nd digit (from left) of 1rst set of labels
C     c1Set2      :: 1rst digit (from left) of  2nd set of labels
C     c2Set2      ::  2nd digit (from left) of  2nd set of labels
C     c1Set3      :: 1rst digit (from left) of  3rd set of labels
C     c2Set3      ::  2nd digit (from left) of  3rd set of labels
C     l1Set       :: length of 1rst digit list
C     l2Set       :: length of  2nd digit list
C     i,j,n       :: loop indices
      CHARACTER*10 c1Set1
      CHARACTER*10 c2Set1
      CHARACTER*10 c1Set2
      CHARACTER*52 c2Set2
      CHARACTER*52 c1Set3
      CHARACTER*62 c2Set3
      INTEGER l1Set, l2Set
      INTEGER i,j,n
CEOP

      c1Set1 = '0123456789'
      c2Set1 = c1Set1

      c1Set2 = c1Set1
      c2Set2 = 'abcdefghijklmnopqrstuvwxyz'
     &       //'ABCDEFGHIJKLMNOPQRSTUVWXYZ'

      c1Set3 = c2Set2
      c2Set3 = c1Set1//c2Set2

C--   Set a default.
C     This should not show up unless there is a problem
C     where nbLbl is equal or greater than 10*10 + 10*52 + 52*62 = 62**2
      DO n=1,nbLbl
       ioLbl(n) = '--'
      ENDDO

      n = 0
C--   First set of labels:
      l1Set = LEN(c1Set1)
      l2Set = LEN(c2Set1)
      DO j=1,l1Set
       DO i=1,l2Set
C-    skip label "00" (since we start tracer numberi from 1)
        IF ( i.NE.1 .OR. j.NE.1 ) THEN
         n=n+1
         IF ( n.LE.nbLbl ) THEN
          ioLbl(n)(1:1) = c1Set1(j:j)
          ioLbl(n)(2:2) = c2Set1(i:i)
         ENDIF
        ENDIF
       ENDDO
      ENDDO

C--   2nd set of labels:
      l1Set = LEN(c1Set2)
      l2Set = LEN(c2Set2)
      DO j=1,l1Set
       DO i=1,l2Set
        n=n+1
        IF ( n.LE.nbLbl ) THEN
          ioLbl(n)(1:1) = c1Set2(j:j)
          ioLbl(n)(2:2) = c2Set2(i:i)
        ENDIF
       ENDDO
      ENDDO

C--   3rd set of labels:
      l1Set = LEN(c1Set3)
      l2Set = LEN(c2Set3)
      DO j=1,l1Set
       DO i=1,l2Set
        n=n+1
        IF ( n.LE.nbLbl ) THEN
          ioLbl(n)(1:1) = c1Set3(j:j)
          ioLbl(n)(2:2) = c2Set3(i:i)
        ENDIF
       ENDDO
      ENDDO

      RETURN
      END