Changeset 845 for IOIPSL/trunk/src/mathelp.f90
- Timestamp:
- 12/10/09 17:26:03 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/src/mathelp.f90
r440 r845 28 28 CONTAINS 29 29 !=== 30 SUBROUTINE buildop (str,ex_topps,topp,nbops_max, & 31 & missing_val,opps,scal,nbops) 30 SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops) 32 31 !--------------------------------------------------------------------- 33 32 !- This subroutine decomposes the input string in the elementary … … 39 38 !- INPUT 40 39 !- 41 !- str: String containing the operations42 !- ex_toops : T he time operations that can be expected43 !- within the string40 !- c_str : String containing the operations 41 !- ex_toops : Time operations that can be expected within the string 42 !- fill_val : 44 43 !- 45 44 !- OUTPUT 46 45 !- 47 !--------------------------------------------------------------------- 48 IMPLICIT NONE 49 !- 50 CHARACTER(LEN=80) :: str 51 CHARACTER(LEN=*) :: ex_topps 52 CHARACTER(LEN=7) :: topp 53 INTEGER :: nbops_max,nbops 54 CHARACTER(LEN=7) :: opps(nbops_max) 55 REAL :: scal(nbops_max),missing_val 56 !- 57 CHARACTER(LEN=80) :: new_str 46 !- topp : Time operation 47 !- opps : 48 !- scal : 49 !- nbops : 50 !--------------------------------------------------------------------- 51 IMPLICIT NONE 52 !- 53 CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps 54 CHARACTER(LEN=*),INTENT(OUT) :: topp 55 CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps 56 REAL,INTENT(IN) :: fill_val 57 REAL,DIMENSION(:),INTENT(OUT) :: scal 58 INTEGER,INTENT(OUT) :: nbops 59 !- 60 CHARACTER(LEN=LEN(c_str)) :: str,new_str 58 61 INTEGER :: leng,ind_opb,ind_clb 59 62 !- … … 62 65 IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning' 63 66 !- 67 str = c_str 64 68 leng = LEN_TRIM(str) 65 69 IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN … … 94 98 & ' buildop : Call decoop ',new_str,ind_opb,ind_clb 95 99 ENDIF 96 CALL decoop (new_str, nbops_max,missing_val,opps,scal,nbops)100 CALL decoop (new_str,fill_val,opps,scal,nbops) 97 101 ELSE 98 102 CALL ipslerr(3,'buildop', & … … 115 119 END SUBROUTINE buildop 116 120 !=== 117 SUBROUTINE decoop (pstr,nbops_max,missing_val,opps,scal,nbops) 118 !--------------------------------------------------------------------- 119 IMPLICIT NONE 120 !- 121 CHARACTER(LEN=80) :: pstr 122 INTEGER :: nbops_max,nbops 123 CHARACTER(LEN=7) :: opps(nbops_max) 124 REAL :: scal(nbops_max),missing_val 125 !- 126 CHARACTER(LEN=1) :: f_char(2),s_char(2) 127 INTEGER :: nbsep,f_pos(2),s_pos(2) 121 SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops) 122 !--------------------------------------------------------------------- 123 IMPLICIT NONE 124 !- 125 CHARACTER(LEN=*),INTENT(IN) :: pstr 126 REAL,INTENT(IN) :: fill_val 127 CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps 128 REAL,DIMENSION(:),INTENT(OUT) :: scal 129 INTEGER,INTENT(OUT) :: nbops 130 !- 131 CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char 132 INTEGER,DIMENSION(2) :: f_pos,s_pos 128 133 CHARACTER(LEN=20) :: opp_str,scal_str 129 CHARACTER(LEN= 80) :: str130 INTEGER :: xpos,leng,ppos,epos,int_tmp134 CHARACTER(LEN=LEN(pstr)) :: str 135 INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp 131 136 CHARACTER(LEN=3) :: tl,dl 132 137 CHARACTER(LEN=10) :: fmt … … 134 139 LOGICAL :: check = .FALSE.,prio 135 140 !--------------------------------------------------------------------- 136 IF (check) WRITE(*,'(2a)') ' decoop : Incoming string : ',pstr 137 !- 138 nbops = 0 139 str = pstr 141 IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr 142 !- 143 str = pstr; nbops = 0; 140 144 !- 141 145 CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos) 142 146 IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep 147 !- 148 nbops_max = min(SIZE(opps),SIZE(scal)) 149 !- 143 150 DO WHILE (nbsep > 0) 151 IF (nbops >= nbops_max) THEN 152 CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ') 153 ENDIF 154 !-- 144 155 xpos = INDEX(str,'X') 145 156 leng = LEN_TRIM(str) … … 147 158 !-- 148 159 IF (check) THEN 149 WRITE(*,*) 'decoop : str -->',str(1:leng) 160 WRITE(*,*) 'decoop : str -> ',TRIM(str) 161 WRITE(*,*) 'decoop : nbops -> ',nbops 150 162 WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2) 151 163 WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2) 152 164 ENDIF 153 !--154 IF (nbops > nbops_max-1) THEN155 CALL ipslerr(3,'decoop','Expression too complex',str,' ')156 ENDIF157 !--158 IF (check) WRITE(*,*) 'decoop : --',nbops,' ',str(1:leng)159 165 !--- 160 166 !-- Start the analysis of the syntax. 3 types of constructs … … 236 242 IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN 237 243 opps(nbops) = opp_str(1:LEN_TRIM(opp_str)) 238 scal(nbops) = missing_val244 scal(nbops) = fill_val 239 245 ELSE 240 246 CALL ipslerr(3,'decoop', & … … 313 319 IMPLICIT NONE 314 320 !- 315 CHARACTER(LEN= 80) :: str321 CHARACTER(LEN=*),INTENT(INOUT) :: str 316 322 INTEGER :: nbsep 317 323 CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char 318 324 INTEGER,DIMENSION(2) :: f_pos,s_pos 319 325 !- 320 CHARACTER(LEN= 70) :: str_tmp326 CHARACTER(LEN=10) :: str_tmp 321 327 LOGICAL :: f_found,s_found 322 328 INTEGER :: ind,xpos,leng,i … … 385 391 WRITE(str_tmp,'("number :",I3)') nbsep 386 392 CALL ipslerr(3,'findsep', & 387 & 'How can I find that many separators',str_tmp, str)393 & 'How can I find that many separators',str_tmp,TRIM(str)) 388 394 ENDIF 389 395 !- … … 399 405 IMPLICIT NONE 400 406 !- 401 CHARACTER(LEN= 80) :: str407 CHARACTER(LEN=*),INTENT(INOUT) :: str 402 408 !- 403 409 INTEGER :: ind,leng,ic,it
Note: See TracChangeset
for help on using the changeset viewer.