2014-10-19 00:57:29 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								subroutine fmtmsg(msg,iz)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-05 08:19:59 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  character*(*) msg
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-19 00:57:29 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Convert all letters to upper case
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-05 08:19:59 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  iz=len(msg)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  do i=1,iz
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-19 00:57:29 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(msg(i:i).ge.'a' .and. msg(i:i).le.'z')                       &
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								          msg(i:i)= char(ichar(msg(i:i))+ichar('A')-ichar('a'))
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(msg(i:i).ne.' ') iz=i
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2018-12-05 08:19:59 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								  do iter=1,37                           !Collapse multiple blanks into one
							 | 
						
					
						
							
								
									
										
										
										
											2014-10-19 00:57:29 +00:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     ib2=index(msg(1:iz),'  ')
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     if(ib2.lt.1) go to 100
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     msg=msg(1:ib2)//msg(ib2+2:)
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								     iz=iz-1
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								  enddo
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								100 return
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								end subroutine fmtmsg
							 |