source: trunk/MESOSCALE/LMDZ.MARS/libf_gcm/bibio/ini36.F @ 134

Last change on this file since 134 was 57, checked in by aslmd, 14 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)

File size: 1.6 KB
Line 
1      SUBROUTINE ini36
2Ccray IMPLICIT NONE
3      IMPLICIT NONE
4c====================================================================
5c-- cette routine fait l'initialisation pour le codage sur base 36
6c-- de la routine to36. on peut utiliser soit 1 soit 2 soit 3 cases
7      INTEGER i,j,k,l, ijk, jk
8c====================================================================
9      INTEGER ibase, ifact1, ifact2, ifact3
10      PARAMETER (ibase=36)
11      PARAMETER (ifact1 = ibase-1)
12      PARAMETER (ifact2 = ibase*ibase-1)
13      PARAMETER (ifact3 = ibase*ibase*ibase-1)
14c====================================================================
15      CHARACTER*1 word1(0:ifact1)
16      COMMON /elbat1/ word1
17      CHARACTER*2 word2(0:ifact2)
18      COMMON /elbat2/ word2
19      CHARACTER*3 word3(0:ifact3)
20      COMMON /elbat3/ word3
21c====================================================================
22      CHARACTER*1 base(ibase)
23      DATA (base(l),l=1,ibase)
24     .     /'0','1','2','3','4','5','6','7','8','9',
25     .      'A','B','C','D','E','F','G','H','I','J',
26     .      'K','L','M','N','O','P','Q','R','S','T',
27     .      'U','V','W','X','Y','Z'/
28c===================================================================
29      DO 30 i = 1, ibase
30      DO 30 j = 1, ibase
31      DO 30 k = 1, ibase
32      ijk = ( (i-1)*ibase + j-1 )*ibase + k-1
33      word3(ijk) = base(i)//base(j)//base(k)
34   30 CONTINUE
35      DO 20 j = 1, ibase
36      DO 20 k = 1, ibase
37      jk = (j-1)*ibase + k-1
38      word2(jk) = base(j)//base(k)
39   20 CONTINUE
40      DO 10 k = 1, ibase
41      word1(k-1) = base(k)
42   10 CONTINUE
43c===================================================================
44      RETURN
45      END
46
Note: See TracBrowser for help on using the repository browser.