PROGRAM gebaeude IMPLICIT NONE INTEGER:: i, j, k, nx, ny, nx1, ny1 INTEGER:: geb, beginni, endei INTEGER:: beginnj, endej REAL:: dx, dy, building_len_x, building_len_y, building_height_z REAL:: building_wall_l !< position of the left wall of the building REAL:: building_wall_s !< position of the southern wall of the building REAL:: positionx, positiony REAL:: diff, building_wall_l_neu CHARACTER(len=40):: anzeige character(len=99) :: jobname INTEGER,DIMENSION(:,:),ALLOCATABLE:: geb3d LOGICAL:: rotation !< Rotation of the building by 45 degrees (only works with square buildings) !--------------------------------------------------------------------------- jobname = 'a4-2' OPEN(1,FILE=trim(jobname)//'_topo') SELECT CASE(jobname) CASE("a1-1","a1-2","a2","a3-2") nx = 335 ny = 83 dx = 2.5 dy = 2.5 building_len_x = 25. building_len_y = 210. building_height_z = 25. building_wall_l = 217.5 building_wall_s = 0. rotation = .FALSE. CASE("a4-1") nx = 335 ny = 83 dx = 2.5 dy = 2.5 building_len_x = 25. building_len_y = 25. building_height_z = 25. building_wall_l = 400. building_wall_s = 92.5 rotation = .FALSE. CASE("a4-2") nx = 671 ny = 167 dx = 1.25 dy = 1.25 building_len_x = 25. building_len_y = 25. building_height_z = 25. building_wall_l = 400. building_wall_s = 92.5 rotation = .FALSE. CASE("a5-1","a5-2") nx = 356 ny = 383 dx = 2.5 dy = 2.5 building_len_x = 25. building_len_y = 25. building_height_z = 25. building_wall_l = 150. building_wall_s = 150. SELECT CASE(jobname) CASE("a5-1") rotation = .FALSE. CASE("a5-2") rotation = .TRUE. END SELECT END SELECT ALLOCATE(geb3d(0:nx,0:ny)) nx1 = nx+1 ny1 = ny+1 geb3d(:,:)=0. IF( .NOT. rotation ) THEN DO i = 0,nx DO j = 0,ny positionx=i*dx positiony=j*dy IF( positionx .GE. building_wall_l .AND. positionx .LE. building_wall_l+building_len_x-1 & .AND. positiony .GE. building_wall_s .AND. positiony .LE. building_wall_s+building_len_y-1 ) THEN geb=INT(building_height_z) ELSE geb=0 ENDIF geb3d(i,j)=geb ENDDO ENDDO ENDIF IF( rotation ) THEN diff=(SQRT(building_len_x**2.+building_len_x**2.)-building_len_x)/2. building_wall_l_neu=building_wall_l-diff geb=INT(building_height_z) beginni=INT(building_wall_l_neu/dx)+1 endei=INT((building_wall_l_neu+SQRT(building_len_x**2.+building_len_x**2.))/dx) beginnj=INT((building_wall_s+building_len_y/2.)/dy) endej=beginnj DO i = 0,nx positionx=i*dx IF( positionx .GE. building_wall_l_neu .AND. positionx .LE. & building_wall_l_neu+SQRT(building_len_x**2.+building_len_x**2.)/2. ) THEN DO j = beginnj,endej geb3d(i,j)=geb ENDDO beginnj=beginnj-1 endej=endej+1 ENDIF IF( positionx .EQ. building_wall_l_neu+SQRT(building_len_x**2.+building_len_x**2.)/2. ) THEN beginnj=beginnj+1 endej=endej-1 ENDIF IF( positionx .GT. building_wall_l_neu+SQRT(building_len_x**2.+building_len_x**2.)/2. & .AND. positionx .LE. building_wall_l_neu+SQRT(building_len_x**2.+building_len_x**2.) ) THEN beginnj=beginnj+1 endej=endej-1 DO j = beginnj,endej geb3d(i,j)=geb ENDDO ENDIF ENDDO ENDIF WRITE(anzeige,*) nx1 DO j = ny,0,-1 WRITE(1,'('//adjustl(anzeige)//'(I4))') ( geb3d(i,j), i=0,nx) ENDDO END PROGRAM gebaeude